Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/execpc.lst
There are no other files named execpc.lst in the archive.
;712 CMU PCL 5(100) release version
; 0001 !<5.1.EXEC>EXECPC.B36.5, 15-Nov-82 02:32:37, Edit by PA0B
; 0002 !Allow DISPLAY integer-expression, Add OUTRANGE to CASE,
; 0003 !Make the square brackets around CASE and SELECT labels
; 0004 !optional (the "approved" syntax is to omit them, but the
; 0005 !compiler allows them), Make complex PARSE really look like
; 0006 !CASE or SELECT by making the "approved" syntax be
; 0007 ! PARSE BEGIN parse-items END ;
; 0008 !instead of
; 0009 ! PARSE ( parse-items ) ;
; 0010 !except that I didn't hack in the optional square bracket
; 0011 !stuff...
; 0012 !<5.1.EXEC>EXECPC.B36.4, 13-Nov-82 14:04:06, Edit by PA0B
; 0013 !Make WILD behave more as documented if paired with PARSEONLY
; 0014 !(if PARSEONLY is specified, WILD doesn't cause GJ%IFG to
; 0015 !be set), Allow DISPLAY'ing of integers
; 0016 !<5.1.EXEC>EXECPC.B36.3, 2-Nov-82 07:47:22, Edit by PA0B
; 0017 !Allow DCM ... TO system-variable, disallow DCM ... TO foo + bar
; 0018 !Make sure values from WORDS are halfword values so they can
; 0019 !go in the right half of TBLUK% entries
; 0020 !<5.1.EXEC>EXECPC.B36.2, 30-Oct-82 15:58:43, Edit by PA0B
; 0021 !Don't get confused in CERROR if line contained "%"'s
; 0022 !<4.EXEC>EXECPC.B36.123, 23-Jun-81 12:46:36, Edit by DK32
; 0023 !Handle stray semicolon after Otherwise field, Make DCm
; 0024 !and PasO synonyms for DoCommand and PassOutput
; 0025 !<4.EXEC>EXECPC.B36.122, 21-May-81 10:36:49, Edit by DK32
; 0026 !Prohibit two Files in one Parse
; 0027 !<4.EXEC>EXECPC.B36.121, 17-Apr-81 22:49:01, Edit by DK32
; 0028 !Allow longer erroneous lines
; 0029 !<4.EXEC>EXECPC.B36.120, 8-Apr-81 15:03:18, Edit by DK32
; 0030 !Protect against impossibly long source lines, Allow
; 0031 !negative keyword values, Fix parenthesized expressions
; 0032 !<4.EXEC>EXECPC.B36.119, 24-Mar-81 20:41:41, Edit by DK32
; 0033 !<4.EXEC>EXECPC.B36.118, 11-Mar-81 15:49:52, Edit by DK32
; 0034 !Allow Parses with command arguments
; 0035 !<4.EXEC>EXECPC.B36.117, 25-Feb-81 21:52:16, Edit by DK32
; 0036 !Prompt, Convert underscores in synonym names, Some
; 0037 !changes for Bliss 2.1, Redo global symbol replacement,
; 0038 !PassOutput
; 0039 !<4.EXEC>EXECPC.B36.116, 22-Jan-81 19:36:11, Edit by DK32
; 0040 !Recognize EOF better
; 0041 !<4.EXEC>EXECPC.B36.115, 12-Jan-81 21:40:30, Edit by DK32
; 0042 !Allow 512-character quoted strings
; 0043 !<4.EXEC>EXECPC.B36.114, 23-Dec-80 18:45:31, Edit by DK32
; 0044 !Use Exec linkage, Clean out CM_SHR, Parse Invisible and
; 0045 !Deleted, Fix Parse Wild+Parseonly
; 0046 !<4.EXEC>EXECPC.B36.113, 15-Dec-80 22:37:56, Edit by DK32
; 0047 !Larger constant work area
; 0048 !<4.EXEC>EXECPC.B36.112, 9-Dec-80 00:20:28, Edit by DK32
; 0049 !Allow overwrite of routines of different classes, Exit
; 0050 !Save and ToProgram
; 0051 !<4.EXEC>EXECPC.B36.111, 26-Nov-80 20:12:08, Edit by DK32
; 0052 !Change an error message, Don't OR together generation
; 0053 !numbers, Change some indenting, Allow for preserved
; 0054 !commands
; 0055 !<4.EXEC>EXECPC.B36.110, 25-Oct-80 23:00:53, Edit by DK32
; 0056 !Handle bad identifier in declaration better, Handle File
; 0057 !with Wild and Parseonly
; 0058 !<4.EXEC>EXECPC.B36.109, 21-Oct-80 18:01:34, Edit by DK32
; 0059 !Allow underscore in system names
; 0060 !<4.EXEC>EXECPC.B36.108, 18-Oct-80 15:52:36, Edit by DK32
; 0061 !Parse FileList, Default_Gen, Wild
; 0062 !<4.EXEC>EXECPC.B36.107, 9-Oct-80 20:36:22, Edit by DK32
; 0063 !Synonym and NoOriginal
; 0064 !<4.EXEC>EXECPC.B36.106, 2-Oct-80 20:09:43, Edit by DK32
; 0065 !Allow terminal semicolon in multiple-field Parse, Allow
; 0066 !Else after short-form Parse, Add Parse NoIndirect and NoHelp,
; 0067 !Fix writeable system variable
; 0068 !<4.EXEC>EXECPC.B36.105, 25-Sep-80 15:07:58, Edit by DK32
; 0069 !Allow commands to replace synonyms, Reset transparency
; 0070 !before first scan, Correct diagnostic for type mismatch
; 0071 !<4.EXEC>EXECPC.B36.104, 15-Sep-80 14:23:04, Edit by DK32
; 0072 !Fix routine replacement, Fudge line number in CALL,
; 0073 !Implement all two-character relationals
; 0074 !<4.EXEC>EXECPC.B36.103, 10-Sep-80 16:04:00, Edit by DK32
; 0075 !Add symbol definitions in source files, Long labels,
; 0076 !Made Let optional, Add parenthesized expressions
; 0077 !<4.EXEC>EXECPC.B36.102, 7-Sep-80 20:40:30, Edit by DK32
; 0078 !Fix Parseonly of File fields, Allow numeric Words, Fix
; 0079 !integer arithmetic, Forbid Parse chaining from Noise fields,
; 0080 !More detail on missing labels, Prohibit declarations after
; 0081 !first statement
; 0082 !<4.EXEC>EXECPC.B36.101, 20-Aug-80 17:23:17, Edit by DK32
; 0083 !Larger constant pool, Better scan status save, Allow for
; 0084 !256-character strings
; 0085 !<DK32.CG>EXECPC.B36.100, 8-Aug-80 17:41:05, Edit by DK32
; 0086 !Don't say "Name not found" for a type mismatch, Point
; 0087 !to correct atom for unrecognized keyword, Allow 100 keywords
; 0088 !<DK32.CG>EXECPC.B36.99, 31-Jul-80 18:52:48, Edit by DK32
; 0089 !Change GETTYPOUT and CLEARTYPOUT to GETTYPEOUT and CLEARTYPEOUT,
; 0090 !Parse command names transparently
; 0091 !<DK32.CG>EXECPC.B36.98, 18-Jul-80 13:40:11, Edit by DK32
; 0092 !Fix quoted strings to not include following character, Change TAD to Daytime
; 0093 !<DK32.CG>EXECPC.B36.97, 17-Jul-80 14:29:40, Edit by DK32
; 0094 !Two doublequotes in a quoted string just generate a doublequote
; 0095 !<DK32.CG>EXECPC.B36.96, 2-Jul-80 14:51:39, Edit by DK32
; 0096 !A form feed is as good as a line feed, Tell CERROR about tabs,
; 0097 !Add Substring[Start:*]
; 0098 MODULE EXECPC =
; 0099 BEGIN
; 0100
; 0101 !++
; 0102 !
; 0103 ! This is the first attempt at the Programmable Command Language compiler
; 0104 !
; 0105 ! Dave King, Carnegie-Mellon University Computation Cenetr
; 0106 !
; 0107 ! January, 1980
; 0108 !
; 0109 ! Copyright (C) 1980, Carnegie-Mellon University
; 0110 !
; 0111 !--
; 0112
; 0113 !
; 0114 ! Standard definitions
; 0115 !
; 0116
; 0117 LIBRARY 'EXECPD';
; 0118 LIBRARY 'BLI:TENDEF';
; 0119 LIBRARY 'BLI:MONSYM';
; WARN#050 ........1 L1:0119
; Name already declared in this block: $CHLFD
; WARN#050 ........1 L1:0119
; Name already declared in this block: $CHCRT
; WARN#050 ........1 L1:0119
; Name already declared in this block: $CHFFD
; 0120 SWITCHES LINKAGE(EXEC);
; 0121
; 0122 !
; 0123 ! Table of contents:
; 0124 !
; 0125
; 0126 FORWARD ROUTINE
; 0127 CERROR, ! Report compilation error
; 0128 SCACHR, ! Return next character from input stream
; 0129 SCAN, ! Get next atom
; 0130 ADDSMB, ! Add current atom to symbol table
; 0131 FNDSMB, ! Find current atom in symbol table
; 0132 DEFLBL: NOVALUE, ! Define label
; 0133 GENINS, ! Generate an instruction
; 0134 GETCNS, ! Find or create constant
; 0135 ASMPRC: NOVALUE, ! Assemble components of procedure
; 0136 DEFPRC: NOVALUE, ! Define procedure in global symbol table
; 0137 PCCCPL: NOVALUE, ! Main entry point to compiler
; 0138 CPVARD: NOVALUE, ! Define a variable
; 0139 CPSYND: NOVALUE, ! Define a synonym
; 0140 CPCMPL: NOVALUE, ! Compile a routine
; 0141 CPRTNC: NOVALUE, ! <Procedure-declaration>
; 0142 CPFRML: NOVALUE, ! <Formal-parameter-list>
; 0143 CPCARG: NOVALUE, ! Command arguments
; 0144 CPBODY: NOVALUE, ! <Procedure-body>
; 0145 CPDECL, ! <Declaration>
; 0146 CPSTMT, ! <Statement>
; 0147 CPASGN: NOVALUE, ! <Assignment-statement>
; 0148 CPCNDI: NOVALUE, ! <Conditional-statement>
; 0149 CPIFST, ! <If-statement>
; 0150 CPGOTO: NOVALUE, ! <Goto-statement>
; 0151 CPCASE: NOVALUE, ! <Case-statement>
; 0152 CPLOOP: NOVALUE, ! <Do-statement>
; 0153 CPSELE: NOVALUE, ! <Select-statement>
; 0154 CPCOMS: NOVALUE, ! Common string statement
; 0155 CPPFRM: NOVALUE, ! <DoCommand-statement>
; 0156 CPGUID: NOVALUE, ! <Guide-statement
; 0157 CPPMPT: NOVALUE, ! <Prompt-statement>
; 0158 CPINVK: NOVALUE, ! <Invoke-statement>
; 0159 CPPRSE: NOVALUE, ! <Parse-statement>
; 0160 CPPRSI, ! <Parse-item>
; 0161 CPPRSO: NOVALUE, ! <Parse-options>
; 0162 CPPRSW, ! <Parse-option> Words
; 0163 CPPRSF: NOVALUE, ! File parse options
; 0164 CPTYIN: NOVALUE, ! Typein statement
; 0165 CPDPLY: NOVALUE, ! Display statement
; 0166 CPEXIT: NOVALUE, ! Exit statement
; 0167 CPCALL: NOVALUE, ! <Call-statement>
; 0168 CPACTL: NOVALUE, ! <Actual-parameter-list>
; 0169 CPRETN: NOVALUE, ! <Return-statement>
; 0170 CPIEXP, ! <Integer-expression>
; 0171 CPSEXP, ! <String-expression>
; 0172 CPLEXP, ! <Logical-expression>
; 0173 CPITRM, ! <Integer-term>
; 0174 CPIPRM, ! <Integer-primary>
; 0175 CPSPRM, ! <String-primary>
; 0176 CPCLSE; ! Classify expression
; 0177
; 0178 !
; 0179 ! Macros:
; 0180 !
; 0181
; 0182 MACRO ERROR(TXT) = CERROR(UPLIT(%ASCIZ TXT)) %;
; 0183
; 0184 !
; 0185 ! External references:
; 0186 !
; 0187
; 0188 EXTERNAL ROUTINE
; 0189 PCMCER, ! Report compilation error
; 0190 PCMITS, ! CVTBDO routine
; 0191 PCMGMM, ! General memory allocator
; 0192 PCIFGS, ! Find global symbol entry
; 0193 PCICGS, ! Create global symbol entry
; 0194 PCIDFV: NOVALUE, ! Define global variable
; 0195 PCIDFS: NOVALUE, ! Define synonym
; 0196 PCIUDF: NOVALUE, ! Undefine global object
; 0197 GTBUFX; ! EXECSU Memory allocate
; 0198
; 0199 EXTERNAL
; 0200 BUF0, ! Temporary work areas
; 0201 PCTEXT: VECTOR, ! Pure text region
; 0202 PCTXFR, ! Pure text free list
; 0203 PCGBST: GST_TBL, ! Global symbol table
; 0204 PSDEFN: SYN_TBL, ! System name table
; 0205 DICT; ! Short term free space pool
; 0206
; 0207 EXTERNAL LITERAL
; 0208 PSDEFL: UNSIGNED(6); ! Length of system name table
; 0209
; 0210 !
; 0211 ! Equated symbols:
; 0212 !
; 0213
; 0214 LITERAL
; 0215 CODWKL = 1024, ! Size of code work area
; 0216 SYMWKL = 512, ! Size of symbol table work area
; 0217 CNSWKL = 3072, ! Size of constant pool work area
; 0218 CURSML = SYMWKL/STE_LEN; ! Maximum index into symbol table work area
; 0219
; 0220 BIND
; 0221 CERM1 = UPLIT(%ASCIZ 'Constants work area full'),
; 0222 CERM2 = UPLIT(%ASCIZ 'Field type missing in Parse, perhaps missing ")"'),
; 0223 CERM3 = UPLIT(%ASCIZ 'Name invalid or missing'),
; 0224 CERM4 = UPLIT(%ASCIZ 'Name not unique'),
; 0225 CERM5 = UPLIT(%ASCIZ 'Unrecognized statement keyword'),
; 0226 CERM6 = UPLIT(%ASCIZ 'Semicolon missing'),
; 0227 CERM7 = UPLIT(%ASCIZ 'END not found where required'),
; 0228 CERM8 = UPLIT(%ASCIZ 'Destination name missing'),
; 0229 CERM9 = UPLIT(%ASCIZ 'Unable to recognize statement'),
; 0230 CERM10 = UPLIT(%ASCIZ 'Too many labels'),
; 0231 CERM11 = UPLIT(%ASCIZ 'Colon missing'),
; 0232 CERM12 = UPLIT(%ASCIZ 'Statement missing'),
; 0233 CERM13 = UPLIT(%ASCIZ 'Integer not found where required'),
; 0234 CERM14 = UPLIT(%ASCIZ 'Right parenthesis missing'),
; 0235 CERM15 = UPLIT(%ASCIZ 'Too many variables'),
; 0236 CERM16 = UPLIT(%ASCIZ 'Left parenthesis missing'),
; 0237 CERM17 = UPLIT(%ASCIZ 'Unexpected end of input'),
; 0238 CERM18 = UPLIT(%ASCIZ 'Unable to recognize expression'),
; 0239 CERM19 = UPLIT(%ASCIZ 'String missing'),
; 0240 CERM20 = UPLIT(%ASCIZ 'OF missing'),
; 0241 CERM21 = UPLIT(%ASCIZ 'BEGIN missing'),
; 0242 CERM22 = UPLIT(%ASCIZ 'Superfluous right bracket'),
; 0243 CERM23 = UPLIT(%ASCIZ 'Right bracket missing'),
; 0244 CERM24 = UPLIT(%ASCIZ 'String not found where required'),
; 0245
; 0246 CODWRK = BUF0: COD_BLK, ! Code work area
; 0247 SYMWRK = CODWRK+CODWKL: SYMENT, ! Symbol table work area
; 0248 CNSWRK = SYMWRK+SYMWKL: VECTOR, ! Constant pool work area
; 0249 CURRTN = CNSWRK+CNSWKL: VECTOR, ! Name of routine being compiled
; 0250 CURNML = CURRTN+8, ! Length of the above
; 0251 CURCLS = CURNML+1, ! Class of routine being compiled
; 0252 CURTYP = CURCLS+1, ! Type of function
; 0253 CURTXT = CURTYP+1, ! Text address of routine
; 0254 PRCARG = CURTXT+1: VECTOR, ! Formal arguments to procedure
; 0255 CMDARG = PRCARG+MAXPRM, ! Constant index of command argument list
; 0256 ! -2 if Parse instead, -1 if neither
; 0257 NEXTIN = CMDARG+1, ! Relative address of next instruction
; 0258 SCAPTR = NEXTIN+1, ! Source pointer
; 0259 SCALIN = SCAPTR+1, ! Source line counter
; 0260 LLNPTR = SCALIN+1, ! Pointer to first character of last line
; 0261 SCATRP = LLNPTR+1, ! Nonzero to scan transparently
; 0262 SCABUF = SCATRP+1: VECTOR, ! Line buffer
; 0263 SCATOM = SCABUF+25: VECTOR, ! Atom buffer
; 0264 SCALEN = SCATOM+103, ! Length of atom
; 0265 SCANUM = SCALEN+1, ! Numeric atom
; 0266 SCACOD = SCANUM+1, ! Scan code of current atom
; 0267 NUMVRS = SCACOD+1, ! Number of variables declared in routine
; 0268 CONSTP = NUMVRS+1, ! Next available constant pool entry
; 0269 SYMTBP = CONSTP+1, ! Next available symbol table index
; 0270 LBLNAM = SYMTBP+1: VECTOR, ! Pointers to label names
; 0271 LBLADR = LBLNAM+MAXLBL: VECTOR, ! Label locations
; 0272 LBLCNT = LBLADR+MAXLBL; ! Number defined
; 0273
; 0274 GLOBAL
; 0275 PCCWKE: INITIAL (LBLCNT); ! Last location used by compiler
; 0276
; 0277 !
; 0278 ! Reserved name table
; 0279 !
; 0280
; 0281 FIELD RSNFLD =
; 0282 SET
; 0283 RSNSTR = [0,0,18,0], ! Address of string
; 0284 RSNLEN = [0,18,9,0], ! Length of string
; 0285 RSNSCN = [0,27,9,0] ! Corresponding scanner code
; 0286 TES;
; 0287
; M 0288 MACRO RESNAM(NAM) =
; 0289 %NAME('SCN_',NAM)^27 + %CHARCOUNT(%STRING(NAM))^18 + UPLIT(%STRING(NAM)) %;
; 0290
; 0291 BIND
; 0292 RSNTBL = PLIT
; 0293 (
; 0294 RESNAM(LSS),
; 0295 RESNAM(LEQ),
; 0296 RESNAM(NEQ),
; 0297 RESNAM(EQL),
; 0298 RESNAM(GTR),
; 0299 RESNAM(GEQ),
; 0300 RESNAM(PROCEDURE),
; 0301 RESNAM(COMMAND),
; 0302 RESNAM(SYNONYM),
; 0303 RESNAM(NOORIGINAL),
; 0304 RESNAM(BEGIN),
; 0305 RESNAM(END),
; 0306 RESNAM(EXTERNAL),
; 0307 RESNAM(INTEGER),
; 0308 RESNAM(STRING),
; 0309 RESNAM(LET),
; 0310 RESNAM(IF),
; 0311 RESNAM(THEN),
; 0312 RESNAM(ELSE),
; 0313 RESNAM(GOTO),
; 0314 RESNAM(RETURN),
; 0315 RESNAM(CASE),
; 0316 RESNAM(FROM),
; 0317 RESNAM(TO),
; 0318 RESNAM(OF),
; 0319 RESNAM(INRANGE),
; 0320 RESNAM(OUTRANGE),
; 0321 RESNAM(DO),
; 0322 RESNAM(WHILE),
; 0323 RESNAM(UNTIL),
; 0324 RESNAM(SELECT),
; 0325 RESNAM(DOCOMMAND),
; 0326 RESNAM(ORIGINAL),
; 0327 RESNAM(GUIDE),
; 0328 RESNAM(PARSE),
; 0329 RESNAM(OTHERWISE),
; 0330 RESNAM(NOINDIRECT),
; 0331 RESNAM(DEFAULT),
; 0332 RESNAM(HELP),
; 0333 RESNAM(NOHELP),
; 0334 RESNAM(WORDS),
; 0335 RESNAM(RADIX),
; 0336 RESNAM(PARSEONLY),
; 0337 RESNAM(STDHELP),
; 0338 RESNAM(TIME),
; 0339 RESNAM(DATE),
; 0340 RESNAM(DEFAULT_DEV),
; 0341 RESNAM(DEFAULT_DIR),
; 0342 RESNAM(DEFAULT_NAM),
; 0343 RESNAM(DEFAULT_EXT),
; 0344 RESNAM(DEFAULT_GEN),
; 0345 RESNAM(INPUT),
; 0346 RESNAM(OUTPUT),
; 0347 RESNAM(WILD),
; 0348 RESNAM(INVISIBLE),
; 0349 RESNAM(DELETED),
; 0350 SCN_ERROR^27 + 5^18 + UPLIT('ERROR'),
; 0351 RESNAM(PROMPT),
; 0352 RESNAM(NOECHO),
; 0353 RESNAM(INVOKE),
; 0354 RESNAM(PASSOUTPUT),
; 0355 RESNAM(TYPEIN),
; 0356 RESNAM(NORETURN),
; 0357 RESNAM(GETTYPEOUT),
; 0358 RESNAM(CLEARTYPEOUT),
; 0359 RESNAM(KILLPROGRAM),
; 0360 RESNAM(DISPLAY),
; 0361 RESNAM(BINARY),
; 0362 RESNAM(EXIT),
; 0363 RESNAM(SAVE),
; 0364 RESNAM(TOPROGRAM),
; 0365 RESNAM(ABORT),
; 0366 RESNAM(NOP),
; 0367 RESNAM(CALL),
; 0368 SCN_DOCOMMAND^27 + 3^18 + UPLIT('DCM'),
; 0369 SCN_PASSOUTPUT^27 + 4^18 + UPLIT('PASO')
; 0370 ): BLOCKVECTOR[1,1] FIELD(RSNFLD);
; 0371
; 0372 LITERAL
; 0373 RSNCNT=77;
; 0374
; 0375 !
; 0376 ! Special characters
; 0377 !
; 0378
; 0379 BIND RESCHR=UPLIT (
; 0380 %C'+',SCN_PLUS, %C'-',SCN_MINUS, %C'*',SCN_TIMES, %C'/',SCN_DIV,
; 0381 %C'=',SCN_EQL, %C'(',SCN_LPAREN, %C')',SCN_RPAREN, %C';',SCN_SEMI,
; 0382 %C':',SCN_COLON,%C',',SCN_COMMA, %C'<',SCN_LSS, %C'>',SCN_GTR,
; 0383 %C'[',SCN_LBRKT,%C']',SCN_RBRKT, %C'"',0) : VECTOR;
; 0384
; 0385 LITERAL
; 0386 RSCCNT=15;
; 0387
; 0388 !
; 0389 ! Field type names for Parse
; 0390 !
; 0391
; M 0392 MACRO FNMDEF(NAM,VAL) =
; 0393 %NAME('$CM',VAL)^27 + %CHARCOUNT(%STRING(NAM))^18 + UPLIT(%STRING(NAM)) %;
; 0394
; 0395 BIND
; 0396 FNMTBL = PLIT
; 0397 (
; 0398 FNMDEF(KEYWORD,KEY),
; 0399 FNMDEF(NUMBER,NUM),
; 0400 FNMDEF(NOISE,NOI),
; 0401 FNMDEF(SWITCH,SWI),
; 0402 FNMDEF(INPUTFILE,IFI),
; 0403 FNMDEF(OUTPUTFILE,OFI),
; 0404 FNMDEF(FILE,FIL),
; 0405 $CMFLD^27 + 5^18 + UPLIT('FIELD'),
; 0406 ! FNMDEF(FIELD,FLD), doesn't work
; 0407 FNMDEF(EOL,CFM),
; 0408 FNMDEF(DIRECTORY,DIR),
; 0409 FNMDEF(USERNAME,USR),
; 0410 FNMDEF(COMMA,CMA),
; 0411 FNMDEF(DEVICE,DEV),
; 0412 FNMDEF(TEXT,TXT),
; 0413 FNMDEF(DAYTIME,TAD),
; 0414 FNMDEF(QUOTEDSTRING,QST),
; 0415 FNMDEF(TOKEN,TOK),
; 0416 FNMDEF(NODE,NOD),
; 0417 FNMDEF(FILELIST,FLS)
; 0418 ): BLOCKVECTOR[1,1] FIELD(RSNFLD);
; 0419
; 0420 LITERAL
; 0421 FNMCNT=19;
; 0422
; 0423 ROUTINE CERROR(MSG,PAR1) = ! Report compilation error
; 0424
; 0425 !++
; 0426 ! Functional description:
; 0427 ! Issue error message, type out offending source line, and stop.
; 0428 ! The error message is provided as an ASCIZ string; anywhere a
; 0429 ! #n appears the n'th message parameter is inserted.
; 0430 !
; 0431 ! Formal parameters:
; 0432 ! Address of error message string
; 0433 ! Address of parameter string #1
; 0434 !
; 0435 ! Implicit inputs:
; 0436 ! LLNPTR, SCALIN
; 0437 !
; 0438 ! Implicit outputs:
; 0439 ! SCATOM
; 0440 !
; 0441 ! Routine value:
; 0442 ! Really, none; does not return. I wish I could convince BLISS of that.
; 0443 !
; 0444 ! Side effects:
; 0445 ! None
; 0446 !
; 0447 !--
; 0448
; 0449 %( Presently only works with one insert )%
; 0450
; 0451 BEGIN
; 0452 EXTERNAL REGISTER Z=0;
; 0453 LOCAL
; 0454 IPT, ! String pointers
; 0455 OPT,
; 0456 POS, ! Horizontal position on line
; 0457 INSRT, ! Insertion pointer
; 0458 CT, ! Character count
; 0459 CHR;
; 0460 IPT = CH$PTR(UPLIT (%ASCIZ 'Line '));
; 0461 OPT = CH$PTR(SCATOM);
; 0462 WHILE (CHR = CH$RCHAR_A(IPT)) NEQ 0 DO CH$WCHAR_A(.CHR,OPT);
; 0463 OPT = PCMITS(.SCALIN,.OPT);
; 0464 CH$WCHAR_A(%C':', OPT);
; 0465 CH$WCHAR_A(%C' ', OPT);
; 0466 IPT = BYTPTR(.MSG);
; 0467 WHILE
; 0468 (CHR = CH$RCHAR_A(IPT)) NEQ 0
; 0469 DO
; 0470 IF .CHR EQL %C'#'
; 0471 THEN
; 0472 BEGIN
; 0473 CH$RCHAR_A(IPT); ! Skip the 1 which must follow
; 0474 INSRT = BYTPTR(.PAR1);
; 0475 WHILE (CHR = CH$RCHAR_A(INSRT)) NEQ 0 DO CH$WCHAR_A(.CHR,OPT)
; 0476 END
; 0477 ELSE
; 0478 CH$WCHAR_A(.CHR,OPT);
; 0479 IPT = .LLNPTR;
; 0480 IF .IPT NEQ 0
; 0481 THEN
; 0482 BEGIN
; 0483 CH$WCHAR_A(%C'%',OPT);
; 0484 CH$WCHAR_A(%C'_',OPT);
; 0485 CH$WCHAR_A(%C'%',OPT);
; 0486 CT = 256;
; 0487 WHILE (CHR = CH$RCHAR_A(IPT)) NEQ $CHCRT AND .CT GTR 5
; 0488 ! DO (CH$WCHAR_A(.CHR,OPT); CT=.CT-1);
; 0489 DO
; 0490 IF (.CHR EQL %C'%') AND (.CT GTR 7)
; 0491 THEN
; 0492 BEGIN
; 0493 CH$WCHAR_A(%C'%',OPT);
; 0494 CH$WCHAR_A(%C'%',OPT);
; 0495 CH$WCHAR_A(%C'%',OPT);
; 0496 CT = .CT-3
; 0497 END
; 0498 ELSE IF (.CHR NEQ %C'%')
; 0499 THEN
; 0500 BEGIN
; 0501 CH$WCHAR_A(.CHR,OPT);
; 0502 CT=.CT-1
; 0503 END
; 0504 ELSE
; 0505 EXITLOOP;
; 0506 CH$WCHAR_A(%C'%',OPT);
; 0507 CH$WCHAR_A(%C'_',OPT);
; 0508 CT = .CT - 2;
; 0509 IPT = .LLNPTR;
; 0510 POS = 0;
; 0511 WHILE
; 0512 (CHR = CH$RCHAR_A(IPT)) NEQ $CHCRT
; 0513 DO
; 0514 IF .IPT EQL .SCAPTR
; 0515 THEN
; 0516 EXITLOOP
; 0517 ELSE
; 0518 IF .CHR EQL $CHTAB
; 0519 THEN
; 0520 DO
; 0521 (IF (CT=.CT-1) GTR 3 THEN CH$WCHAR_A(%C'.',OPT);
; 0522 POS=.POS+1)
; 0523 UNTIL
; 0524 .POS MOD 8 EQL 0
; 0525 ELSE
; 0526 BEGIN
; 0527 IF (CT=.CT-1) GTR 3 THEN CH$WCHAR_A(%C'.',OPT);
; 0528 POS = .POS + 1
; 0529 END;
; 0530 IF (CT=.CT-1) GTR 1 THEN CH$WCHAR_A(%C'^',OPT)
; 0531 END;
; 0532 CH$WCHAR_A($CHNUL,OPT);
; 0533 PCMCER(SCATOM)
; 0534 END;
TITLE EXECPC
TWOSEG
.REQUEST SYS:B362LB.REL
RELOC 400000
P.AAA: BYTE (7)"C","o","n","s","t" ; Const
BYTE (7)"a","n","t","s"," " ; ants
BYTE (7)"w","o","r","k"," " ; work
BYTE (7)"a","r","e","a"," " ; area
BYTE (7)"f","u","l","l",000 ; full
P.AAB: BYTE (7)"F","i","e","l","d" ; Field
BYTE (7)" ","t","y","p","e" ; type
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g"," ","i" ; ing i
BYTE (7)"n"," ","P","a","r" ; n Par
BYTE (7)"s","e",","," ","p" ; se, p
BYTE (7)"e","r","h","a","p" ; erhap
BYTE (7)"s"," ","m","i","s" ; s mis
BYTE (7)"s","i","n","g"," " ; sing
BYTE (7)042,")",042,000,000 ; ")"
P.AAC: BYTE (7)"N","a","m","e"," " ; Name
BYTE (7)"i","n","v","a","l" ; inval
BYTE (7)"i","d"," ","o","r" ; id or
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
P.AAD: BYTE (7)"N","a","m","e"," " ; Name
BYTE (7)"n","o","t"," ","u" ; not u
BYTE (7)"n","i","q","u","e" ; nique
BYTE (7)000,000,000,000,000
P.AAE: BYTE (7)"U","n","r","e","c" ; Unrec
BYTE (7)"o","g","n","i","z" ; ogniz
BYTE (7)"e","d"," ","s","t" ; ed st
BYTE (7)"a","t","e","m","e" ; ateme
BYTE (7)"n","t"," ","k","e" ; nt ke
BYTE (7)"y","w","o","r","d" ; yword
BYTE (7)000,000,000,000,000
P.AAF: BYTE (7)"S","e","m","i","c" ; Semic
BYTE (7)"o","l","o","n"," " ; olon
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
P.AAG: BYTE (7)"E","N","D"," ","n" ; END n
BYTE (7)"o","t"," ","f","o" ; ot fo
BYTE (7)"u","n","d"," ","w" ; und w
BYTE (7)"h","e","r","e"," " ; here
BYTE (7)"r","e","q","u","i" ; requi
BYTE (7)"r","e","d",000,000 ; red
P.AAH: BYTE (7)"D","e","s","t","i" ; Desti
BYTE (7)"n","a","t","i","o" ; natio
BYTE (7)"n"," ","n","a","m" ; n nam
BYTE (7)"e"," ","m","i","s" ; e mis
BYTE (7)"s","i","n","g",000 ; sing
P.AAI: BYTE (7)"U","n","a","b","l" ; Unabl
BYTE (7)"e"," ","t","o"," " ; e to
BYTE (7)"r","e","c","o","g" ; recog
BYTE (7)"n","i","z","e"," " ; nize
BYTE (7)"s","t","a","t","e" ; state
BYTE (7)"m","e","n","t",000 ; ment
P.AAJ: BYTE (7)"T","o","o"," ","m" ; Too m
BYTE (7)"a","n","y"," ","l" ; any l
BYTE (7)"a","b","e","l","s" ; abels
BYTE (7)000,000,000,000,000
P.AAK: BYTE (7)"C","o","l","o","n" ; Colon
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
P.AAL: BYTE (7)"S","t","a","t","e" ; State
BYTE (7)"m","e","n","t"," " ; ment
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
P.AAM: BYTE (7)"I","n","t","e","g" ; Integ
BYTE (7)"e","r"," ","n","o" ; er no
BYTE (7)"t"," ","f","o","u" ; t fou
BYTE (7)"n","d"," ","w","h" ; nd wh
BYTE (7)"e","r","e"," ","r" ; ere r
BYTE (7)"e","q","u","i","r" ; equir
BYTE (7)"e","d",000,000,000 ; ed
P.AAN: BYTE (7)"R","i","g","h","t" ; Right
BYTE (7)" ","p","a","r","e" ; pare
BYTE (7)"n","t","h","e","s" ; nthes
BYTE (7)"i","s"," ","m","i" ; is mi
BYTE (7)"s","s","i","n","g" ; ssing
BYTE (7)000,000,000,000,000
P.AAO: BYTE (7)"T","o","o"," ","m" ; Too m
BYTE (7)"a","n","y"," ","v" ; any v
BYTE (7)"a","r","i","a","b" ; ariab
BYTE (7)"l","e","s",000,000 ; les
P.AAP: BYTE (7)"L","e","f","t"," " ; Left
BYTE (7)"p","a","r","e","n" ; paren
BYTE (7)"t","h","e","s","i" ; thesi
BYTE (7)"s"," ","m","i","s" ; s mis
BYTE (7)"s","i","n","g",000 ; sing
P.AAQ: BYTE (7)"U","n","e","x","p" ; Unexp
BYTE (7)"e","c","t","e","d" ; ected
BYTE (7)" ","e","n","d"," " ; end
BYTE (7)"o","f"," ","i","n" ; of in
BYTE (7)"p","u","t",000,000 ; put
P.AAR: BYTE (7)"U","n","a","b","l" ; Unabl
BYTE (7)"e"," ","t","o"," " ; e to
BYTE (7)"r","e","c","o","g" ; recog
BYTE (7)"n","i","z","e"," " ; nize
BYTE (7)"e","x","p","r","e" ; expre
BYTE (7)"s","s","i","o","n" ; ssion
BYTE (7)000,000,000,000,000
P.AAS: BYTE (7)"S","t","r","i","n" ; Strin
BYTE (7)"g"," ","m","i","s" ; g mis
BYTE (7)"s","i","n","g",000 ; sing
P.AAT: BYTE (7)"O","F"," ","m","i" ; OF mi
BYTE (7)"s","s","i","n","g" ; ssing
BYTE (7)000,000,000,000,000
P.AAU: BYTE (7)"B","E","G","I","N" ; BEGIN
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
P.AAV: BYTE (7)"S","u","p","e","r" ; Super
BYTE (7)"f","l","u","o","u" ; fluou
BYTE (7)"s"," ","r","i","g" ; s rig
BYTE (7)"h","t"," ","b","r" ; ht br
BYTE (7)"a","c","k","e","t" ; acket
BYTE (7)000,000,000,000,000
P.AAW: BYTE (7)"R","i","g","h","t" ; Right
BYTE (7)" ","b","r","a","c" ; brac
BYTE (7)"k","e","t"," ","m" ; ket m
BYTE (7)"i","s","s","i","n" ; issin
BYTE (7)"g",000,000,000,000 ; g
P.AAX: BYTE (7)"S","t","r","i","n" ; Strin
BYTE (7)"g"," ","n","o","t" ; g not
BYTE (7)" ","f","o","u","n" ; foun
BYTE (7)"d"," ","w","h","e" ; d whe
BYTE (7)"r","e"," ","r","e" ; re re
BYTE (7)"q","u","i","r","e" ; quire
BYTE (7)"d",000,000,000,000 ; d
P.AAZ: BYTE (7)"L","S","S",000,000 ; LSS
P.ABA: BYTE (7)"L","E","Q",000,000 ; LEQ
P.ABB: BYTE (7)"N","E","Q",000,000 ; NEQ
P.ABC: BYTE (7)"E","Q","L",000,000 ; EQL
P.ABD: BYTE (7)"G","T","R",000,000 ; GTR
P.ABE: BYTE (7)"G","E","Q",000,000 ; GEQ
P.ABF: BYTE (7)"P","R","O","C","E" ; PROCE
BYTE (7)"D","U","R","E",000 ; DURE
P.ABG: BYTE (7)"C","O","M","M","A" ; COMMA
BYTE (7)"N","D",000,000,000 ; ND
P.ABH: BYTE (7)"S","Y","N","O","N" ; SYNON
BYTE (7)"Y","M",000,000,000 ; YM
P.ABI: BYTE (7)"N","O","O","R","I" ; NOORI
BYTE (7)"G","I","N","A","L" ; GINAL
P.ABJ: BYTE (7)"B","E","G","I","N" ; BEGIN
P.ABK: BYTE (7)"E","N","D",000,000 ; END
P.ABL: BYTE (7)"E","X","T","E","R" ; EXTER
BYTE (7)"N","A","L",000,000 ; NAL
P.ABM: BYTE (7)"I","N","T","E","G" ; INTEG
BYTE (7)"E","R",000,000,000 ; ER
P.ABN: BYTE (7)"S","T","R","I","N" ; STRIN
BYTE (7)"G",000,000,000,000 ; G
P.ABO: BYTE (7)"L","E","T",000,000 ; LET
P.ABP: BYTE (7)"I","F",000,000,000 ; IF
P.ABQ: BYTE (7)"T","H","E","N",000 ; THEN
P.ABR: BYTE (7)"E","L","S","E",000 ; ELSE
P.ABS: BYTE (7)"G","O","T","O",000 ; GOTO
P.ABT: BYTE (7)"R","E","T","U","R" ; RETUR
BYTE (7)"N",000,000,000,000 ; N
P.ABU: BYTE (7)"C","A","S","E",000 ; CASE
P.ABV: BYTE (7)"F","R","O","M",000 ; FROM
P.ABW: BYTE (7)"T","O",000,000,000 ; TO
P.ABX: BYTE (7)"O","F",000,000,000 ; OF
P.ABY: BYTE (7)"I","N","R","A","N" ; INRAN
BYTE (7)"G","E",000,000,000 ; GE
P.ABZ: BYTE (7)"O","U","T","R","A" ; OUTRA
BYTE (7)"N","G","E",000,000 ; NGE
P.ACA: BYTE (7)"D","O",000,000,000 ; DO
P.ACB: BYTE (7)"W","H","I","L","E" ; WHILE
P.ACC: BYTE (7)"U","N","T","I","L" ; UNTIL
P.ACD: BYTE (7)"S","E","L","E","C" ; SELEC
BYTE (7)"T",000,000,000,000 ; T
P.ACE: BYTE (7)"D","O","C","O","M" ; DOCOM
BYTE (7)"M","A","N","D",000 ; MAND
P.ACF: BYTE (7)"O","R","I","G","I" ; ORIGI
BYTE (7)"N","A","L",000,000 ; NAL
P.ACG: BYTE (7)"G","U","I","D","E" ; GUIDE
P.ACH: BYTE (7)"P","A","R","S","E" ; PARSE
P.ACI: BYTE (7)"O","T","H","E","R" ; OTHER
BYTE (7)"W","I","S","E",000 ; WISE
P.ACJ: BYTE (7)"N","O","I","N","D" ; NOIND
BYTE (7)"I","R","E","C","T" ; IRECT
P.ACK: BYTE (7)"D","E","F","A","U" ; DEFAU
BYTE (7)"L","T",000,000,000 ; LT
P.ACL: BYTE (7)"H","E","L","P",000 ; HELP
P.ACM: BYTE (7)"N","O","H","E","L" ; NOHEL
BYTE (7)"P",000,000,000,000 ; P
P.ACN: BYTE (7)"W","O","R","D","S" ; WORDS
P.ACO: BYTE (7)"R","A","D","I","X" ; RADIX
P.ACP: BYTE (7)"P","A","R","S","E" ; PARSE
BYTE (7)"O","N","L","Y",000 ; ONLY
P.ACQ: BYTE (7)"S","T","D","H","E" ; STDHE
BYTE (7)"L","P",000,000,000 ; LP
P.ACR: BYTE (7)"T","I","M","E",000 ; TIME
P.ACS: BYTE (7)"D","A","T","E",000 ; DATE
P.ACT: BYTE (7)"D","E","F","A","U" ; DEFAU
BYTE (7)"L","T","_","D","E" ; LT_DE
BYTE (7)"V",000,000,000,000 ; V
P.ACU: BYTE (7)"D","E","F","A","U" ; DEFAU
BYTE (7)"L","T","_","D","I" ; LT_DI
BYTE (7)"R",000,000,000,000 ; R
P.ACV: BYTE (7)"D","E","F","A","U" ; DEFAU
BYTE (7)"L","T","_","N","A" ; LT_NA
BYTE (7)"M",000,000,000,000 ; M
P.ACW: BYTE (7)"D","E","F","A","U" ; DEFAU
BYTE (7)"L","T","_","E","X" ; LT_EX
BYTE (7)"T",000,000,000,000 ; T
P.ACX: BYTE (7)"D","E","F","A","U" ; DEFAU
BYTE (7)"L","T","_","G","E" ; LT_GE
BYTE (7)"N",000,000,000,000 ; N
P.ACY: BYTE (7)"I","N","P","U","T" ; INPUT
P.ACZ: BYTE (7)"O","U","T","P","U" ; OUTPU
BYTE (7)"T",000,000,000,000 ; T
P.ADA: BYTE (7)"W","I","L","D",000 ; WILD
P.ADB: BYTE (7)"I","N","V","I","S" ; INVIS
BYTE (7)"I","B","L","E",000 ; IBLE
P.ADC: BYTE (7)"D","E","L","E","T" ; DELET
BYTE (7)"E","D",000,000,000 ; ED
P.ADD: BYTE (7)"E","R","R","O","R" ; ERROR
P.ADE: BYTE (7)"P","R","O","M","P" ; PROMP
BYTE (7)"T",000,000,000,000 ; T
P.ADF: BYTE (7)"N","O","E","C","H" ; NOECH
BYTE (7)"O",000,000,000,000 ; O
P.ADG: BYTE (7)"I","N","V","O","K" ; INVOK
BYTE (7)"E",000,000,000,000 ; E
P.ADH: BYTE (7)"P","A","S","S","O" ; PASSO
BYTE (7)"U","T","P","U","T" ; UTPUT
P.ADI: BYTE (7)"T","Y","P","E","I" ; TYPEI
BYTE (7)"N",000,000,000,000 ; N
P.ADJ: BYTE (7)"N","O","R","E","T" ; NORET
BYTE (7)"U","R","N",000,000 ; URN
P.ADK: BYTE (7)"G","E","T","T","Y" ; GETTY
BYTE (7)"P","E","O","U","T" ; PEOUT
P.ADL: BYTE (7)"C","L","E","A","R" ; CLEAR
BYTE (7)"T","Y","P","E","O" ; TYPEO
BYTE (7)"U","T",000,000,000 ; UT
P.ADM: BYTE (7)"K","I","L","L","P" ; KILLP
BYTE (7)"R","O","G","R","A" ; ROGRA
BYTE (7)"M",000,000,000,000 ; M
P.ADN: BYTE (7)"D","I","S","P","L" ; DISPL
BYTE (7)"A","Y",000,000,000 ; AY
P.ADO: BYTE (7)"B","I","N","A","R" ; BINAR
BYTE (7)"Y",000,000,000,000 ; Y
P.ADP: BYTE (7)"E","X","I","T",000 ; EXIT
P.ADQ: BYTE (7)"S","A","V","E",000 ; SAVE
P.ADR: BYTE (7)"T","O","P","R","O" ; TOPRO
BYTE (7)"G","R","A","M",000 ; GRAM
P.ADS: BYTE (7)"A","B","O","R","T" ; ABORT
P.ADT: BYTE (7)"N","O","P",000,000 ; NOP
P.ADU: BYTE (7)"C","A","L","L",000 ; CALL
P.ADV: BYTE (7)"D","C","M",000,000 ; DCM
P.ADW: BYTE (7)"P","A","S","O",000 ; PASO
EXP 114
P.AAY: EXP P.AAZ+10003000000
EXP P.ABA+11003000000
EXP P.ABB+12003000000
EXP P.ABC+13003000000
EXP P.ABD+14003000000
EXP P.ABE+15003000000
EXP P.ABF+25011000000
EXP P.ABG+26007000000
EXP P.ABH+27007000000
EXP P.ABI+30012000000
EXP P.ABJ+31005000000
EXP P.ABK+32003000000
EXP P.ABL+33010000000
EXP P.ABM+34007000000
EXP P.ABN+35006000000
EXP P.ABO+36003000000
EXP P.ABP+37002000000
EXP P.ABQ+40004000000
EXP P.ABR+41004000000
EXP P.ABS+42004000000
EXP P.ABT+43006000000
EXP P.ABU+44004000000
EXP P.ABV+45004000000
EXP P.ABW+46002000000
EXP P.ABX+47002000000
EXP P.ABY+50007000000
EXP P.ABZ+51010000000
EXP P.ACA+52002000000
EXP P.ACB+53005000000
EXP P.ACC+54005000000
EXP P.ACD+55006000000
EXP P.ACE+56011000000
EXP P.ACF+57010000000
EXP P.ACG+60005000000
EXP P.ACH+61005000000
EXP P.ACI+62011000000
EXP P.ACJ+63012000000
EXP P.ACK+64007000000
EXP P.ACL+65004000000
EXP P.ACM+66006000000
EXP P.ACN+67005000000
EXP P.ACO+70005000000
EXP P.ACP+71011000000
EXP P.ACQ+72007000000
EXP P.ACR+73004000000
EXP P.ACS+74004000000
EXP P.ACT+75013000000
EXP P.ACU+76013000000
EXP P.ACV+77013000000
EXP P.ACW+100013000000
EXP P.ACX+101013000000
EXP P.ACY+102005000000
EXP P.ACZ+103006000000
EXP P.ADA+104004000000
EXP P.ADB+105011000000
EXP P.ADC+106007000000
EXP P.ADD+107005000000
EXP P.ADE+110006000000
EXP P.ADF+111006000000
EXP P.ADG+113006000000
EXP P.ADH+114012000000
EXP P.ADI+115006000000
EXP P.ADJ+116010000000
EXP P.ADK+117012000000
EXP P.ADL+120014000000
EXP P.ADM+121013000000
EXP P.ADN+122007000000
EXP P.ADO+123006000000
EXP P.ADP+124004000000
EXP P.ADQ+125004000000
EXP P.ADR+126011000000
EXP P.ADS+127005000000
EXP P.ADT+130003000000
EXP P.ADU+131004000000
EXP P.ADV+56003000000
EXP P.ADW+114004000000
P.ADX: EXP 53
EXP 4
EXP 55
EXP 5
EXP 52
EXP 6
EXP 57
EXP 7
EXP 75
EXP 13
EXP 50
EXP 16
EXP 51
EXP 17
EXP 73
EXP 20
EXP 72
EXP 22
EXP 54
EXP 21
EXP 74
EXP 10
EXP 76
EXP 14
EXP 133
EXP 23
EXP 135
EXP 24
EXP 42
EXP 0
P.ADZ: BYTE (7)"K","E","Y","W","O" ; KEYWO
BYTE (7)"R","D",000,000,000 ; RD
P.AEA: BYTE (7)"N","U","M","B","E" ; NUMBE
BYTE (7)"R",000,000,000,000 ; R
P.AEB: BYTE (7)"N","O","I","S","E" ; NOISE
P.AEC: BYTE (7)"S","W","I","T","C" ; SWITC
BYTE (7)"H",000,000,000,000 ; H
P.AED: BYTE (7)"I","N","P","U","T" ; INPUT
BYTE (7)"F","I","L","E",000 ; FILE
P.AEE: BYTE (7)"O","U","T","P","U" ; OUTPU
BYTE (7)"T","F","I","L","E" ; TFILE
P.AEF: BYTE (7)"F","I","L","E",000 ; FILE
P.AEG: BYTE (7)"F","I","E","L","D" ; FIELD
P.AEH: BYTE (7)"E","O","L",000,000 ; EOL
P.AEI: BYTE (7)"D","I","R","E","C" ; DIREC
BYTE (7)"T","O","R","Y",000 ; TORY
P.AEJ: BYTE (7)"U","S","E","R","N" ; USERN
BYTE (7)"A","M","E",000,000 ; AME
P.AEK: BYTE (7)"C","O","M","M","A" ; COMMA
P.AEL: BYTE (7)"D","E","V","I","C" ; DEVIC
BYTE (7)"E",000,000,000,000 ; E
P.AEM: BYTE (7)"T","E","X","T",000 ; TEXT
P.AEN: BYTE (7)"D","A","Y","T","I" ; DAYTI
BYTE (7)"M","E",000,000,000 ; ME
P.AEO: BYTE (7)"Q","U","O","T","E" ; QUOTE
BYTE (7)"D","S","T","R","I" ; DSTRI
BYTE (7)"N","G",000,000,000 ; NG
P.AEP: BYTE (7)"T","O","K","E","N" ; TOKEN
P.AEQ: BYTE (7)"N","O","D","E",000 ; NODE
P.AER: BYTE (7)"F","I","L","E","L" ; FILEL
BYTE (7)"I","S","T",000,000 ; IST
EXP 23
P.ADY: EXP P.ADZ+7000000
EXP P.AEA+1006000000
EXP P.AEB+2005000000
EXP P.AEC+3006000000
EXP P.AED+4011000000
EXP P.AEE+5012000000
EXP P.AEF+6004000000
EXP P.AEG+7005000000
EXP P.AEH+10003000000
EXP P.AEI+11011000000
EXP P.AEJ+12010000000
EXP P.AEK+13005000000
EXP P.AEL+16006000000
EXP P.AEM+17004000000
EXP P.AEN+20007000000
EXP P.AEO+21014000000
EXP P.AEP+23005000000
EXP P.AEQ+26004000000
EXP P.AER+27010000000
P.AES: BYTE (7)"L","i","n","e"," " ; Line
BYTE (7)000,000,000,000,000
RELOC 0
PCCWKE::EXP LBLCNT
EXTERN PCMCER, PCMITS, PCMGMM, PCIFGS, PCICGS, PCIDFV, PCIDFS, PCIUDF, GTBUFX, BUF0, PCTEXT
EXTERN PCTXFR, PCGBST, PSDEFN, DICT, PSDEFL
CERM1= P.AAA
CERM2= P.AAB
CERM3= P.AAC
CERM4= P.AAD
CERM5= P.AAE
CERM6= P.AAF
CERM7= P.AAG
CERM8= P.AAH
CERM9= P.AAI
CERM10= P.AAJ
CERM11= P.AAK
CERM12= P.AAL
CERM13= P.AAM
CERM14= P.AAN
CERM15= P.AAO
CERM16= P.AAP
CERM17= P.AAQ
CERM18= P.AAR
CERM19= P.AAS
CERM20= P.AAT
CERM21= P.AAU
CERM22= P.AAV
CERM23= P.AAW
CERM24= P.AAX
CODWRK= BUF0
SYMWRK= BUF0+2000
CNSWRK= BUF0+3000
CURRTN= BUF0+11000
CURNML= BUF0+11010
CURCLS= BUF0+11011
CURTYP= BUF0+11012
CURTXT= BUF0+11013
PRCARG= BUF0+11014
CMDARG= BUF0+11024
NEXTIN= BUF0+11025
SCAPTR= BUF0+11026
SCALIN= BUF0+11027
LLNPTR= BUF0+11030
SCATRP= BUF0+11031
SCABUF= BUF0+11032
SCATOM= BUF0+11063
SCALEN= BUF0+11232
SCANUM= BUF0+11233
SCACOD= BUF0+11234
NUMVRS= BUF0+11235
CONSTP= BUF0+11236
SYMTBP= BUF0+11237
LBLNAM= BUF0+11240
LBLADR= BUF0+11264
LBLCNT= BUF0+11310
RSNTBL= P.AAY
RESCHR= P.ADX
FNMTBL= P.ADY
AC0= 0
AC1= 1
AC2= 2
AC3= 3
AC4= 4
AC5= 5
AC6= 6
AC7= 7
AC10= 10
AC11= 11
AC12= 12
AC13= 13
AC14= 14
FP= 15
AC16= 16
SP= 17
RELOC 400626
CERROR: PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC11,AC2 ; PAR1,AC2
MOVE AC12,AC1 ; MSG,AC1
MOVE AC13,C.1 ; IPT,[POINT 7,P.AES-1,34] <1,7>
MOVE AC4,C.2 ; OPT,[POINT 7,BUF0+11062,34] <1,7>
L.1: ILDB AC14,AC13 ; CHR,IPT
JUMPE AC14,L.2 ; CHR,L.2
IDPB AC14,AC4 ; CHR,OPT
JRST L.1 ; L.1
L.2: MOVE AC1,SCALIN ; AC1,SCALIN
MOVE AC2,AC4 ; AC2,OPT
PUSHJ SP,PCMITS ; SP,PCMITS
MOVE AC4,AC1 ; OPT,AC1
MOVEI AC1,72 ; AC1,72
IDPB AC1,AC4 ; AC1,OPT
MOVEI AC1,40 ; AC1,40
IDPB AC1,AC4 ; AC1,OPT
MOVE AC1,AC12 ; HLF,MSG
HRLI AC1,-337100 ; HLF,-337100
MOVE AC13,AC1 ; IPT,HLF
L.3: ILDB AC14,AC13 ; CHR,IPT
JUMPE AC14,L.6 ; CHR,L.6
CAIE AC14,43 ; CHR,43
JRST L.5 ; L.5
IBP AC13 ; IPT
MOVE AC1,AC11 ; HLF,PAR1
HRLI AC1,-337100 ; HLF,-337100
MOVE AC2,AC1 ; INSRT,HLF
L.4: ILDB AC14,AC2 ; CHR,INSRT
JUMPE AC14,L.3 ; CHR,L.3
IDPB AC14,AC4 ; CHR,OPT
JRST L.4 ; L.4
L.5: IDPB AC14,AC4 ; CHR,OPT
JRST L.3 ; L.3
L.6: MOVE AC13,LLNPTR ; IPT,LLNPTR
JUMPE AC13,L.16 ; IPT,L.16
MOVEI AC1,45 ; AC1,45
IDPB AC1,AC4 ; AC1,OPT
MOVEI AC1,137 ; AC1,137
IDPB AC1,AC4 ; AC1,OPT
MOVEI AC1,45 ; AC1,45
IDPB AC1,AC4 ; AC1,OPT
MOVEI AC3,400 ; CT,400
L.7: ILDB AC14,AC13 ; CHR,IPT
CAIE AC14,15 ; CHR,15
CAIG AC3,5 ; CT,5
JRST L.9 ; L.9
CAIN AC14,45 ; CHR,45
CAIG AC3,7 ; CT,7
JRST L.8 ; L.8
MOVEI AC1,45 ; AC1,45
IDPB AC1,AC4 ; AC1,OPT
MOVEI AC1,45 ; AC1,45
IDPB AC1,AC4 ; AC1,OPT
MOVEI AC1,45 ; AC1,45
IDPB AC1,AC4 ; AC1,OPT
SUBI AC3,3 ; CT,3
JRST L.7 ; L.7
L.8: CAIN AC14,45 ; CHR,45
JRST L.9 ; L.9
IDPB AC14,AC4 ; CHR,OPT
SOJA AC3,L.7 ; CT,L.7
L.9: MOVEI AC1,45 ; AC1,45
IDPB AC1,AC4 ; AC1,OPT
MOVEI AC1,137 ; AC1,137
IDPB AC1,AC4 ; AC1,OPT
SUBI AC3,2 ; CT,2
MOVE AC13,LLNPTR ; IPT,LLNPTR
SETZ AC5, ; POS,
L.10: ILDB AC14,AC13 ; CHR,IPT
CAIE AC14,15 ; CHR,15
CAMN AC13,SCAPTR ; IPT,SCAPTR
JRST L.15 ; L.15
CAIE AC14,11 ; CHR,11
JRST L.13 ; L.13
L.11: SUBI AC3,1 ; CT,1
CAIG AC3,3 ; CT,3
JRST L.12 ; L.12
MOVEI AC1,56 ; AC1,56
IDPB AC1,AC4 ; AC1,OPT
L.12: AOS AC1,AC5 ; AC1,POS
IDIVI AC1,10 ; AC1,10
JUMPN AC2,L.11 ; AC2,L.11
JRST L.10 ; L.10
L.13: SUBI AC3,1 ; CT,1
CAIG AC3,3 ; CT,3
JRST L.14 ; L.14
MOVEI AC1,56 ; AC1,56
IDPB AC1,AC4 ; AC1,OPT
L.14: AOJA AC5,L.10 ; POS,L.10
L.15: SUBI AC3,1 ; CT,1
CAIG AC3,1 ; CT,1
JRST L.16 ; L.16
MOVEI AC1,136 ; AC1,136
IDPB AC1,AC4 ; AC1,OPT
L.16: SETZ AC1, ; AC1,
IDPB AC1,AC4 ; AC1,OPT
MOVE AC1,C.3 ; AC1,[SCATOM]
PUSHJ SP,PCMCER ; SP,PCMCER
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POPJ SP, ; SP,
C.1: POINT 7,P.AES-1,34 ; 7,P.AES-1,34
C.2: POINT 7,BUF0+11062,34 ; 7,BUF0+11062,34
C.3: EXP SCATOM ; SCATOM
; Routine Size: 110 words
; 0535
; 0536 ROUTINE SCACHR = ! Return next character from input stream
; 0537
; 0538 !++
; 0539 ! Functional description:
; 0540 ! Returns next character from source input stream.
; 0541 !
; 0542 ! Formal parameters:
; 0543 ! None
; 0544 !
; 0545 ! Implicit inputs:
; 0546 ! Source pointer
; 0547 !
; 0548 ! Implicit outputs:
; 0549 ! Last line-start pointer, line counter
; 0550 !
; 0551 ! Routine value:
; 0552 ! ASCII character from source; a null indicates the end
; 0553 !
; 0554 ! Side effects:
; 0555 ! None
; 0556 !
; 0557 !--
; 0558
; 0559 BEGIN
; 0560 LOCAL
; 0561 CHR;
; 0562 CHR = CH$RCHAR_A(SCAPTR);
; 0563 IF .CHR EQL $CHLFD OR .CHR EQL $CHFFD
; 0564 THEN
; 0565 BEGIN
; 0566 SCALIN = .SCALIN + 1;
; 0567 LLNPTR = .SCAPTR
; 0568 END
; 0569 ELSE
; 0570 IF .CHR EQL $CHNUL THEN LLNPTR = 0;
; 0571 .CHR
; 0572 END;
SCACHR: ILDB AC1,SCAPTR ; CHR,SCAPTR
CAIN AC1,12 ; CHR,12
JRST L.17 ; L.17
CAIE AC1,14 ; CHR,14
JRST L.18 ; L.18
L.17: AOS SCALIN ; SCALIN
MOVE AC2,SCAPTR ; AC2,SCAPTR
MOVEM AC2,LLNPTR ; AC2,LLNPTR
POPJ SP, ; SP,
L.18: JUMPN AC1,L.19 ; CHR,L.19
SETZM LLNPTR ; LLNPTR
L.19: POPJ SP, ; SP,
; Routine Size: 12 words
; 0573
; 0574 ROUTINE SCAN = ! Get next atom
; 0575
; 0576 !++
; 0577 ! Functional description:
; 0578 ! Reads next atom from source file and converts it into scan code.
; 0579 ! Conversion may require resolution of reserved words and special
; 0580 ! symbols, and interpretation of numeric and string constants.
; 0581 ! Comments are skipped as they are read; alphabetic atoms are folded
; 0582 ! to upper case (outside quoted strings). Alphabetic atoms are
; 0583 ! returned transparently (i.e., not converted into reserved words)
; 0584 ! if the SCATRP flag is set. Returns scan code; end-of-file is
; 0585 ! represented by a particular scan code. If atom type requires it,
; 0586 ! atom is left in SCATOM, with length in SCALEN, or in SCANUM.
; 0587 !
; 0588 ! Formal parameters:
; 0589 ! None
; 0590 !
; 0591 ! Implicit inputs:
; 0592 ! Source characters, reserved character and word tables, SCATRP
; 0593 !
; 0594 ! Implicit outputs:
; 0595 ! SCATOM, SCALEN, SCACOD, SCANUM
; 0596 !
; 0597 ! Routine value:
; 0598 ! Scan code
; 0599 !
; 0600 ! Side effects:
; 0601 ! None
; 0602 !
; 0603 !--
; 0604
; 0605 BEGIN
; 0606 EXTERNAL REGISTER Z=0;
; 0607 LOCAL CHR;
; 0608 DO
; 0609 BEGIN
; 0610 CHR = SCACHR();
; 0611 IF .CHR EQL %O'41'
; 0612 THEN
; 0613 DO CHR=SCACHR() UNTIL (.CHR EQL $CHLFD) OR (.CHR EQL $CHFFD)
; 0614 OR (.CHR EQL 0)
; 0615 END
; 0616 WHILE
; 0617 ((.CHR EQL %C' ') OR (.CHR EQL $CHCRT) OR (.CHR EQL $CHLFD)
; 0618 OR (.CHR EQL 9) OR (.CHR EQL $CHFFD));
; 0619 IF .CHR LEQ 0 THEN RETURN (SCACOD=SCN_EOFILE);
; 0620 IF .CHR GEQ %C'a' AND .CHR LEQ %C'z' THEN CHR = .CHR - %C'a'+%C'A';
; 0621 SELECTONE .CHR OF
; 0622 SET
; 0623 [%C'A' TO %C'Z']:
; 0624 BEGIN
; 0625 ! Scan an alphanumeric string of some sort, either a reserved
; 0626 ! word or a user identifier. Copy the string into the atom
; 0627 ! buffer, then look it up in the reserved word table and
; 0628 ! set the scan code appropriately.
; 0629 LOCAL
; 0630 PTR, ! String pointer
; 0631 LEN, ! String length
; 0632 PTRI, ! More pointers
; 0633 PTRO;
; 0634 PTR = CH$PTR(SCATOM);
; 0635 SCATOM[0] = 0;
; 0636 LEN=0;
; 0637 DO
; 0638 BEGIN
; 0639 LEN=.LEN+1;
; 0640 IF .LEN GTR 40 THEN ERROR('Atom too long');
; 0641 CH$WCHAR_A(.CHR,PTR);
; 0642 CHR = SCACHR();
; 0643 IF .CHR GEQ %C'a' AND .CHR LEQ %C'z' THEN CHR = .CHR - %C'a'+%C'A'
; 0644 END
; 0645 WHILE
; 0646 (.CHR GEQ %C'A' AND .CHR LEQ %C'Z') OR
; 0647 (.CHR GEQ %C'0' AND .CHR LEQ %C'9') OR .CHR EQL %C'_';
; 0648 CH$WCHAR_A($CHNUL,PTR);
; 0649 SCACOD = SCN_IDENT;
; 0650 SCALEN = .LEN;
; 0651 IF .SCATRP EQL 0
; 0652 THEN
; 0653 (DECR PTR FROM RSNCNT-1 DO
; 0654 IF .LEN EQL .RSNTBL[.PTR,RSNLEN]
; 0655 THEN
; 0656 IF CH$EQL(.LEN,CH$PTR(SCATOM),
; 0657 .LEN,BYTPTR(.RSNTBL[.PTR,RSNSTR]))
; 0658 THEN
; 0659 (SCACOD = .RSNTBL[.PTR,RSNSCN]; EXITLOOP);
; 0660 0)
; 0661 END;
; 0662 [%C'0' TO %C'9']:
; 0663 BEGIN
; 0664 ! Scan a decimal number, store in atom buffer.
; 0665 LOCAL NUM;
; 0666 NUM=0;
; 0667 DO
; 0668 (NUM=.NUM*10+.CHR-%C'0'; CHR=SCACHR())
; 0669 WHILE
; 0670 .CHR GEQ %C'0' AND .CHR LEQ %C'9';
; 0671 SCANUM = .NUM;
; 0672 SCACOD = SCN_NUMB
; 0673 END;
; 0674 [%C'$']:
; 0675 BEGIN
; 0676 ! Scan a system identifier, store in atom buffer
; 0677 LOCAL
; 0678 PTR, ! Pointer to atom buffer
; 0679 LEN; ! Name length
; 0680 PTR = CH$PTR(SCATOM);
; 0681 SCATOM[0] = 0;
; 0682 LEN = 0;
; 0683 DO
; 0684 BEGIN
; 0685 CHR = SCACHR();
; 0686 IF .CHR GEQ %C'a' AND .CHR LEQ %C'z' THEN CHR=.CHR-%C'a'+%C'A';
; 0687 IF (.CHR GEQ %C'A' AND .CHR LEQ %C'Z') OR .CHR EQL %C'_'
; 0688 THEN
; 0689 BEGIN
; 0690 CH$WCHAR_A(.CHR,PTR);
; 0691 LEN = .LEN + 1
; 0692 END
; 0693 END
; 0694 WHILE
; 0695 (.CHR GEQ %C'A' AND .CHR LEQ %C'Z') OR .CHR EQL %C'_';
; 0696 PTR =
; 0697 (DECR I FROM PSDEFL-1 DO
; 0698 IF .PSDEFN[.I,SYN_NML] EQL .LEN THEN
; 0699 IF CH$EQL( .LEN,CH$PTR(SCATOM),
; 0700 .LEN,BYTPTR(.PSDEFN[.I,SYN_NAM]))
; 0701 THEN
; 0702 EXITLOOP .I);
; 0703 IF .PTR LSS 0 THEN ERROR('No such system name');
; 0704 SCATOM = .PTR;
; 0705 SCACOD = SCN_SYSNAME
; 0706 END;
; 0707 [OTHERWISE]:
; 0708 BEGIN
; 0709 ! Scan a special character
; 0710 SCACOD =
; 0711 (DECR I FROM RSCCNT-1 DO
; 0712 IF .CHR EQL .RESCHR[.I*2]
; 0713 THEN
; 0714 EXITLOOP .RESCHR[.I*2+1]);
; 0715 IF .SCACOD LSS 0 THEN ERROR('Illegal character');
; 0716 IF .CHR EQL %C'"'
; 0717 THEN
; 0718 BEGIN
; 0719 ! Quoted string
; 0720 LOCAL
; 0721 LEN,
; 0722 PTRO;
; 0723 PTRO = CH$PTR(SCATOM);
; 0724 LEN=0;
; 0725 WHILE
; 0726 1
; 0727 DO
; 0728 BEGIN
; 0729 CHR = SCACHR();
; 0730 IF .CHR EQL %C'"'
; 0731 THEN
; 0732 BEGIN
; 0733 CHR = SCACHR();
; 0734 IF .CHR NEQ %C'"' THEN EXITLOOP
; 0735 END;
; 0736 LEN = .LEN + 1;
; 0737 IF .LEN GTR 512 THEN ERROR('String over 512 characters');
; 0738 CH$WCHAR_A(.CHR,PTRO)
; 0739 END;
; 0740 CH$WCHAR_A($CHNUL,PTRO);
; 0741 SCACOD = SCN_QSTRING;
; 0742 SCALEN = .LEN
; 0743 END
; 0744 ELSE
; 0745 IF .CHR EQL %C'<'
; 0746 THEN
; 0747 BEGIN
; 0748 CHR = SCACHR();
; 0749 IF .CHR EQL %C'>'
; 0750 THEN
; 0751 BEGIN
; 0752 SCACOD = SCN_NEQ;
; 0753 SCACHR()
; 0754 END
; 0755 ELSE
; 0756 IF .CHR EQL %C'='
; 0757 THEN
; 0758 BEGIN
; 0759 SCACOD = SCN_LEQ;
; 0760 SCACHR()
; 0761 END
; 0762 END
; 0763 ELSE
; 0764 IF .CHR EQL %C'>'
; 0765 THEN
; 0766 BEGIN
; 0767 IF SCACHR() EQL %C'='
; 0768 THEN
; 0769 BEGIN
; 0770 SCACOD = SCN_GEQ;
; 0771 SCACHR()
; 0772 END
; 0773 END
; 0774 ELSE
; 0775 SCACHR()
; 0776 END;
; 0777 TES;
; 0778 SCAPTR = CH$PLUS(.SCAPTR, -1);
; 0779 .SCACOD
; 0780 END;
P.AET: BYTE (7)"A","t","o","m"," " ; Atom
BYTE (7)"t","o","o"," ","l" ; too l
BYTE (7)"o","n","g",000,000 ; ong
P.AEU: BYTE (7)"N","o"," ","s","u" ; No su
BYTE (7)"c","h"," ","s","y" ; ch sy
BYTE (7)"s","t","e","m"," " ; stem
BYTE (7)"n","a","m","e",000 ; name
P.AEV: BYTE (7)"I","l","l","e","g" ; Illeg
BYTE (7)"a","l"," ","c","h" ; al ch
BYTE (7)"a","r","a","c","t" ; aract
BYTE (7)"e","r",000,000,000 ; er
P.AEW: BYTE (7)"S","t","r","i","n" ; Strin
BYTE (7)"g"," ","o","v","e" ; g ove
BYTE (7)"r"," ","5","1","2" ; r 512
BYTE (7)" ","c","h","a","r" ; char
BYTE (7)"a","c","t","e","r" ; acter
BYTE (7)"s",000,000,000,000 ; s
SCAN: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
L.20: PUSHJ SP,SCACHR ; SP,SCACHR
MOVE AC14,AC1 ; CHR,AC1
CAIE AC14,41 ; CHR,41
JRST L.22 ; L.22
L.21: PUSHJ SP,SCACHR ; SP,SCACHR
MOVE AC14,AC1 ; CHR,AC1
CAIE AC14,12 ; CHR,12
CAIN AC14,14 ; CHR,14
JRST L.22 ; L.22
JUMPN AC14,L.21 ; CHR,L.21
L.22: CAIE AC14,40 ; CHR,40
CAIN AC14,15 ; CHR,15
JRST L.20 ; L.20
CAIE AC14,12 ; CHR,12
CAIN AC14,11 ; CHR,11
JRST L.20 ; L.20
CAIN AC14,14 ; CHR,14
JRST L.20 ; L.20
JUMPG AC14,L.23 ; CHR,L.23
MOVEI AC1,132 ; AC1,132
MOVEM AC1,SCACOD ; AC1,SCACOD
JRST L.62 ; L.62
L.23: CAIL AC14,141 ; CHR,141
CAILE AC14,172 ; CHR,172
JRST L.24 ; L.24
SUBI AC14,40 ; CHR,40
L.24: CAIL AC14,101 ; CHR,101
CAILE AC14,132 ; CHR,132
JRST L.32 ; L.32
MOVE AC12,C.2 ; PTR,[POINT 7,BUF0+11062,34] <1,7>
SETZB AC13,SCATOM ; LEN,SCATOM
L.25: ADDI AC13,1 ; LEN,1
CAIG AC13,50 ; LEN,50
JRST L.26 ; L.26
MOVEI AC1,P.AET ; AC1,P.AET
PUSHJ SP,CERROR ; SP,CERROR
L.26: IDPB AC14,AC12 ; CHR,PTR
PUSHJ SP,SCACHR ; SP,SCACHR
MOVE AC14,AC1 ; CHR,AC1
CAIL AC14,141 ; CHR,141
CAILE AC14,172 ; CHR,172
JRST L.27 ; L.27
SUBI AC14,40 ; CHR,40
L.27: CAIGE AC14,101 ; CHR,101
JRST L.28 ; L.28
CAIG AC14,132 ; CHR,132
JRST L.25 ; L.25
L.28: CAIGE AC14,60 ; CHR,60
JRST L.29 ; L.29
CAIG AC14,71 ; CHR,71
JRST L.25 ; L.25
L.29: CAIN AC14,137 ; CHR,137
JRST L.25 ; L.25
SETZ AC1, ; AC1,
IDPB AC1,AC12 ; AC1,PTR
MOVEI AC1,1 ; AC1,1
MOVEM AC1,SCACOD ; AC1,SCACOD
MOVEM AC13,SCALEN ; LEN,SCALEN
SKIPE SCATRP ; SCATRP
JRST L.61 ; L.61
MOVEI AC3,114 ; PTR,114
L.30: LDB AC1,C.4 ; AC1,[POINT 9,RSNTBL(PTR),17] <18,9>
CAME AC13,AC1 ; LEN,AC1
JRST L.31 ; L.31
HRRZ AC5,RSNTBL(AC3) ; HLF,RSNTBL(PTR)
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,AC13 ; AC1,LEN
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
MOVE AC4,AC13 ; AC4,LEN
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.31 ; L.31
LDB AC1,C.6 ; AC1,[POINT 9,RSNTBL(PTR),8] <27,9>
JRST L.46 ; L.46
L.31: SOJGE AC3,L.30 ; PTR,L.30
JRST L.61 ; L.61
L.32: CAIL AC14,60 ; CHR,60
CAILE AC14,71 ; CHR,71
JRST L.35 ; L.35
SETZ AC13, ; NUM,
L.33: MOVE AC1,AC13 ; AC1,NUM
IMULI AC1,12 ; AC1,12
ADD AC1,AC14 ; AC1,CHR
MOVE AC13,AC1 ; NUM,AC1
SUBI AC13,60 ; NUM,60
PUSHJ SP,SCACHR ; SP,SCACHR
MOVE AC14,AC1 ; CHR,AC1
CAIL AC14,60 ; CHR,60
CAILE AC14,71 ; CHR,71
JRST L.34 ; L.34
JRST L.33 ; L.33
L.34: MOVEM AC13,SCANUM ; NUM,SCANUM
MOVEI AC1,2 ; AC1,2
JRST L.46 ; L.46
L.35: CAIE AC14,44 ; CHR,44
JRST L.47 ; L.47
MOVE AC12,C.2 ; PTR,[POINT 7,BUF0+11062,34] <1,7>
SETZB AC13,SCATOM ; LEN,SCATOM
L.36: PUSHJ SP,SCACHR ; SP,SCACHR
MOVE AC14,AC1 ; CHR,AC1
CAIL AC14,141 ; CHR,141
CAILE AC14,172 ; CHR,172
JRST L.37 ; L.37
SUBI AC14,40 ; CHR,40
L.37: CAIGE AC14,101 ; CHR,101
JRST L.38 ; L.38
CAIG AC14,132 ; CHR,132
JRST L.39 ; L.39
L.38: CAIE AC14,137 ; CHR,137
JRST L.40 ; L.40
L.39: IDPB AC14,AC12 ; CHR,PTR
ADDI AC13,1 ; LEN,1
L.40: CAIGE AC14,101 ; CHR,101
JRST L.41 ; L.41
CAIG AC14,132 ; CHR,132
JRST L.36 ; L.36
L.41: CAIN AC14,137 ; CHR,137
JRST L.36 ; L.36
MOVEI AC3,PSDEFL-1 ; I,PSDEFL-1
AOJA AC3,L.43 ; I,L.43
L.42: MOVE AC1,AC3 ; AC1,I
IMULI AC1,2 ; AC1,2
HRRZ AC2,PSDEFN(AC1) ; AC2,PSDEFN(AC1)
CAME AC2,AC13 ; AC2,LEN
JRST L.43 ; L.43
HLRZ AC5,PSDEFN+1(AC1) ; HLF,PSDEFN+1(AC1)
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,AC13 ; AC1,LEN
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
MOVE AC4,AC13 ; AC4,LEN
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.43 ; L.43
MOVE AC12,AC3 ; PTR,I
JRST L.44 ; L.44
L.43: SOJGE AC3,L.42 ; I,L.42
SETO AC12, ; PTR,
L.44: JUMPGE AC12,L.45 ; PTR,L.45
MOVEI AC1,P.AEU ; AC1,P.AEU
PUSHJ SP,CERROR ; SP,CERROR
L.45: MOVEM AC12,SCATOM ; PTR,SCATOM
MOVEI AC1,112 ; AC1,112
L.46: MOVEM AC1,SCACOD ; AC1,SCACOD
JRST L.61 ; L.61
L.47: MOVEI AC1,34 ; I,34
L.48: CAME AC14,RESCHR(AC1) ; CHR,RESCHR(I)
JRST L.49 ; L.49
MOVE AC1,RESCHR+1(AC1) ; AC1,RESCHR+1(I)
JRST L.50 ; L.50
L.49: SUBI AC1,2 ; I,2
JUMPGE AC1,L.48 ; I,L.48
SETO AC1, ; AC1,
L.50: MOVEM AC1,SCACOD ; AC1,SCACOD
SKIPL SCACOD ; SCACOD
JRST L.51 ; L.51
MOVEI AC1,P.AEV ; AC1,P.AEV
PUSHJ SP,CERROR ; SP,CERROR
L.51: CAIE AC14,42 ; CHR,42
JRST L.56 ; L.56
MOVE AC12,C.2 ; PTRO,[POINT 7,BUF0+11062,34] <1,7>
SETZ AC13, ; LEN,
L.52: PUSHJ SP,SCACHR ; SP,SCACHR
MOVE AC14,AC1 ; CHR,AC1
CAIE AC14,42 ; CHR,42
JRST L.53 ; L.53
PUSHJ SP,SCACHR ; SP,SCACHR
MOVE AC14,AC1 ; CHR,AC1
CAIE AC14,42 ; CHR,42
JRST L.55 ; L.55
L.53: ADDI AC13,1 ; LEN,1
CAIG AC13,1000 ; LEN,1000
JRST L.54 ; L.54
MOVEI AC1,P.AEW ; AC1,P.AEW
PUSHJ SP,CERROR ; SP,CERROR
L.54: IDPB AC14,AC12 ; CHR,PTRO
JRST L.52 ; L.52
L.55: SETZ AC1, ; AC1,
IDPB AC1,AC12 ; AC1,PTRO
MOVEI AC1,3 ; AC1,3
MOVEM AC1,SCACOD ; AC1,SCACOD
MOVEM AC13,SCALEN ; LEN,SCALEN
JRST L.61 ; L.61
L.56: CAIE AC14,74 ; CHR,74
JRST L.58 ; L.58
PUSHJ SP,SCACHR ; SP,SCACHR
MOVE AC14,AC1 ; CHR,AC1
CAIE AC14,76 ; CHR,76
JRST L.57 ; L.57
MOVEI AC1,12 ; AC1,12
JRST L.59 ; L.59
L.57: CAIE AC14,75 ; CHR,75
JRST L.61 ; L.61
MOVEI AC1,11 ; AC1,11
JRST L.59 ; L.59
L.58: CAIE AC14,76 ; CHR,76
JRST L.60 ; L.60
PUSHJ SP,SCACHR ; SP,SCACHR
CAIE AC1,75 ; AC1,75
JRST L.61 ; L.61
MOVEI AC1,15 ; AC1,15
L.59: MOVEM AC1,SCACOD ; AC1,SCACOD
L.60: PUSHJ SP,SCACHR ; SP,SCACHR
L.61: SETO AC1, ; AC1,
ADJBP AC1,SCAPTR ; AC1,SCAPTR
MOVEM AC1,SCAPTR ; AC1,SCAPTR
MOVE AC1,SCACOD ; AC1,SCACOD
L.62: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.4: POINT 9,RSNTBL(AC3),17 ; 9,RSNTBL(PTR),17
C.5: CMPSE ;
C.6: POINT 9,RSNTBL(AC3),8 ; 9,RSNTBL(PTR),8
; Routine Size: 214 words
; 0781
; 0782 ROUTINE ADDSMB = ! Add current atom to symbol table
; 0783
; 0784 !++
; 0785 ! Functional description:
; 0786 ! Define the current atom as a new entry in the symbol table,
; 0787 ! and return the index of the new entry. Entry must be unique;
; 0788 ! duplicate names return -1. Fills in only the name, so the
; 0789 ! caller must fill in everything else as he sees fit.
; 0790 !
; 0791 ! Formal parameters:
; 0792 ! None
; 0793 !
; 0794 ! Implicit inputs:
; 0795 ! Current atom
; 0796 !
; 0797 ! Implicit outputs:
; 0798 ! Symbol table, constants (to store identifier name)
; 0799 !
; 0800 ! Routine value:
; 0801 ! Index of new symbol table entry, or -1 if not unique
; 0802 !
; 0803 ! Side effects:
; 0804 ! None
; 0805 !
; 0806 !--
; 0807
; 0808 BEGIN
; 0809 EXTERNAL REGISTER Z=0;
; 0810 LOCAL
; 0811 CHR, ! Character
; 0812 SYMP, ! Symbol table index
; 0813 CP; ! Constant table index
; 0814 LABEL
; 0815 F;
; 0816 DECR I FROM .SYMTBP-1 DO
; 0817 IF .SCALEN EQL .SYMWRK[.I,STE_NML] THEN
; 0818 IF CH$EQL( .SCALEN,CH$PTR(SCATOM),
; 0819 .SCALEN,BYTPTR(CNSWRK[.SYMWRK[.I,STE_NMA]]))
; 0820 THEN
; 0821 RETURN -1;
; 0822 SYMP = .SYMTBP;
; 0823 SYMTBP = .SYMTBP+1;
; 0824 IF .SYMTBP GTR CURSML THEN ERROR('Compiler symbol table full');
; 0825 SYMWRK[.SYMP,STE_VLD] = STE_VLD_NUM;
; 0826 CP =
; 0827 F: BEGIN
; 0828 LOCAL VAL;
; 0829 DECR I FROM .CONSTP-1 DO
; 0830 IF CH$EQL(.SCALEN+1,CH$PTR(SCATOM),.SCALEN+1,BYTPTR(CNSWRK[.I]))
; 0831 THEN
; 0832 LEAVE F WITH .I;
; 0833 IF .CONSTP + (.SCALEN+5)/5 GTR CNSWKL
; 0834 THEN
; 0835 CERROR(CERM1);
; 0836 CH$COPY(.SCALEN,CH$PTR(SCATOM),0,.SCALEN+1,BYTPTR(CNSWRK[.CONSTP]));
; 0837 VAL = .CONSTP;
; 0838 CONSTP = .CONSTP + (.SCALEN+5)/5;
; 0839 .VAL
; 0840 END;
; 0841 SYMWRK[.SYMP,STE_NML] = .SCALEN;
; 0842 SYMWRK[.SYMP,STE_NMA] = .CP;
; 0843 .SYMP
; 0844 END;
P.AEX: BYTE (7)"C","o","m","p","i" ; Compi
BYTE (7)"l","e","r"," ","s" ; ler s
BYTE (7)"y","m","b","o","l" ; ymbol
BYTE (7)" ","t","a","b","l" ; tabl
BYTE (7)"e"," ","f","u","l" ; e ful
BYTE (7)"l",000,000,000,000 ; l
ADDSMB: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC3,SYMTBP ; I,SYMTBP
JRST L.64 ; L.64
L.63: MOVE AC1,AC3 ; AC1,I
IMULI AC1,2 ; AC1,2
HLRZ AC2,SYMWRK+1(AC1) ; AC2,SYMWRK+1(AC1)
CAME AC2,SCALEN ; AC2,SCALEN
JRST L.64 ; L.64
HRRZ AC5,SYMWRK+1(AC1) ; HLF,SYMWRK+1(AC1)
ADD AC5,C.9 ; HLF,[CNSWRK]
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,SCALEN ; AC1,SCALEN
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
MOVE AC4,SCALEN ; AC4,SCALEN
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.64 ; L.64
SETO AC1, ; AC1,
JRST L.70 ; L.70
L.64: SOJGE AC3,L.63 ; I,L.63
MOVE AC13,SYMTBP ; SYMP,SYMTBP
AOS SYMTBP ; SYMTBP
MOVEI AC1,400 ; AC1,400
CAML AC1,SYMTBP ; AC1,SYMTBP
JRST L.65 ; L.65
MOVEI AC1,P.AEX ; AC1,P.AEX
PUSHJ SP,CERROR ; SP,CERROR
L.65: MOVE AC14,AC13 ; AC14,SYMP
IMULI AC14,2 ; AC14,2
MOVEI AC1,2 ; AC1,2
DPB AC1,C.7 ; AC1,[POINT 3,SYMWRK(AC14),2] <33,3>
MOVE AC16,SCALEN ; AC16,SCALEN
ADDI AC16,1 ; AC16,1
MOVE AC3,CONSTP ; I,CONSTP
JRST L.67 ; L.67
L.66: MOVE AC5,AC3 ; HLF,I
ADD AC5,C.9 ; HLF,[CNSWRK]
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,AC16 ; AC1,AC16
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
MOVE AC4,AC16 ; AC4,AC16
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.67 ; L.67
JRST L.69 ; L.69
L.67: SOJGE AC3,L.66 ; I,L.66
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
ADD AC1,CONSTP ; AC1,CONSTP
CAIG AC1,6000 ; AC1,6000
JRST L.68 ; L.68
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.68: MOVE AC4,SCALEN ; AC4,SCALEN
ADDI AC4,1 ; AC4,1
MOVE AC5,CONSTP ; HLF,CONSTP
ADD AC5,C.9 ; HLF,[CNSWRK]
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,SCALEN ; AC1,SCALEN
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
EXTEND AC1,C.8 ; AC1,C.8
JFCL ;
MOVE AC3,CONSTP ; VAL,CONSTP
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
ADDM AC1,CONSTP ; AC1,CONSTP
L.69: MOVE AC1,SCALEN ; AC1,SCALEN
HRLM AC1,SYMWRK+1(AC14) ; AC1,SYMWRK+1(AC14)
HRRM AC3,SYMWRK+1(AC14) ; CP,SYMWRK+1(AC14)
MOVE AC1,AC13 ; AC1,SYMP
L.70: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.7: POINT 3,SYMWRK(AC14),2 ; 3,SYMWRK(AC14),2
C.8: MOVSLJ ;
EXP 0 ; 0
C.9: EXP CNSWRK ; CNSWRK
; Routine Size: 78 words
; 0845
; 0846 ROUTINE FNDSMB(CLASS,TYPE) = ! Find current atom in symbol table
; 0847
; 0848 !++
; 0849 ! Functional description:
; 0850 ! Search symbol table for entry with the same name as the current
; 0851 ! atom, and the same class, and data type if a variable or function.
; 0852 !
; 0853 ! Formal parameters:
; 0854 ! Class of symbol (STE_CLS), -1 if unimportant
; 0855 ! Type of variable or function (STE_TYP), -1 if unimportant
; 0856 !
; 0857 ! Implicit inputs:
; 0858 ! Symbol table, current atom
; 0859 !
; 0860 ! Implicit outputs:
; 0861 ! None
; 0862 !
; 0863 ! Routine value:
; 0864 ! Symbol table index of entry,
; 0865 ! -1 if name not found,
; 0866 ! -2 if name found but of wrong class or type
; 0867 !
; 0868 ! Side effects:
; 0869 ! None
; 0870 !
; 0871 !--
; 0872
; 0873 DECR I FROM .SYMTBP-1 DO
; 0874 IF .SYMWRK[.I,STE_NML] EQL .SCALEN THEN
; 0875 IF CH$EQL( .SCALEN,CH$PTR(SCATOM),
; 0876 .SCALEN,BYTPTR(CNSWRK[.SYMWRK[.I,STE_NMA]]))
; 0877 THEN
; 0878 BEGIN
; 0879 IF .CLASS GEQ 0 AND .SYMWRK[.I,STE_CLS] NEQ .CLASS
; 0880 THEN
; 0881 RETURN -2;
; 0882 IF .SYMWRK[.I,STE_CLS] NEQ STE_CLS_PRC
; 0883 THEN
; 0884 IF .TYPE GEQ 0 AND .SYMWRK[.I,STE_TYP] NEQ .TYPE
; 0885 THEN
; 0886 RETURN -2;
; 0887 RETURN .I
; 0888 END;
FNDSMB: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC13,AC2 ; TYPE,AC2
MOVE AC14,AC1 ; CLASS,AC1
MOVE AC16,SYMTBP ; I,SYMTBP
JRST L.75 ; L.75
L.71: MOVE AC3,AC16 ; AC3,I
IMULI AC3,2 ; AC3,2
HLRZ AC1,SYMWRK+1(AC3) ; AC1,SYMWRK+1(AC3)
CAME AC1,SCALEN ; AC1,SCALEN
JRST L.75 ; L.75
HRRZ AC5,SYMWRK+1(AC3) ; HLF,SYMWRK+1(AC3)
ADD AC5,C.9 ; HLF,[CNSWRK]
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,SCALEN ; AC1,SCALEN
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
MOVE AC4,SCALEN ; AC4,SCALEN
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.75 ; L.75
JUMPL AC14,L.72 ; CLASS,L.72
LDB AC1,C.10 ; AC1,[POINT 3,SYMWRK(AC3),5] <30,3>
CAME AC1,AC14 ; AC1,CLASS
JRST L.73 ; L.73
L.72: LDB AC1,C.10 ; AC1,[POINT 3,SYMWRK(AC3),5] <30,3>
CAIN AC1,3 ; AC1,3
JRST L.74 ; L.74
JUMPL AC13,L.74 ; TYPE,L.74
LDB AC1,C.11 ; AC1,[POINT 1,SYMWRK(AC3),6] <29,1>
CAMN AC1,AC13 ; AC1,TYPE
JRST L.74 ; L.74
L.73: HRROI AC1,-2 ; AC1,-2
JRST L.76 ; L.76
L.74: MOVE AC1,AC16 ; AC1,I
JRST L.76 ; L.76
L.75: SOJGE AC16,L.71 ; I,L.71
SETO AC1, ; AC1,
L.76: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.10: POINT 3,SYMWRK(AC3),5 ; 3,SYMWRK(AC3),5
C.11: POINT 1,SYMWRK(AC3),6 ; 1,SYMWRK(AC3),6
; Routine Size: 41 words
; 0889
; 0890 ROUTINE DEFLBL: NOVALUE = ! Define label
; 0891
; 0892 !++
; 0893 ! Functional description:
; 0894 ! Defines the current atom to be a label with a given code index,
; 0895 ! by locating or creating an entry in the label table.
; 0896 ! If the entry already exists with outstanding references,
; 0897 ! they are resolved.
; 0898 !
; 0899 ! Formal parameters:
; 0900 ! None
; 0901 !
; 0902 ! Implicit inputs:
; 0903 ! Current atom
; 0904 !
; 0905 ! Implicit outputs:
; 0906 ! Label table, code
; 0907 !
; 0908 ! Routine value:
; 0909 ! None
; 0910 !
; 0911 ! Side effects:
; 0912 ! None
; 0913 !
; 0914 !--
; 0915
; 0916 BEGIN
; 0917 EXTERNAL REGISTER Z=0;
; 0918 LOCAL
; 0919 LPTR; ! Label table index
; 0920 LPTR =
; 0921 (DECR I FROM .LBLCNT-1 DO
; 0922 IF CH$EQL(.SCALEN+1, .LBLNAM[.I], .SCALEN+1, BYTPTR(SCATOM))
; 0923 THEN
; 0924 EXITLOOP .I);
; 0925 IF .LPTR LSS 0
; 0926 THEN
; 0927 BEGIN
; 0928 LBLNAM[.LBLCNT] = BYTPTR(PCMGMM((.SCALEN+5)/5, DICT));
; 0929 CH$MOVE(.SCALEN+1, BYTPTR(SCATOM), .LBLNAM[.LBLCNT]);
; 0930 LBLADR[.LBLCNT] = .NEXTIN;
; 0931 LBLCNT = .LBLCNT + 1;
; 0932 IF .LBLCNT GTR MAXLBL THEN CERROR(CERM10)
; 0933 END
; 0934 ELSE
; 0935 IF .LBLADR[.LPTR] LSS 0
; 0936 THEN
; 0937 BEGIN
; 0938 LOCAL
; 0939 CPTR, ! Code pointers
; 0940 NPTR,
; 0941 HLFTMP: HLF_WRD;
; 0942 CPTR = - .LBLADR[.LPTR];
; 0943 WHILE
; 0944 .CPTR GTR 0
; 0945 DO
; 0946 BEGIN
; 0947 IF .CPTR LSS 2^17
; 0948 THEN
; 0949 BEGIN
; 0950 NPTR = .CODWRK[.CPTR,COD_OPA];
; 0951 CODWRK[.CPTR,COD_OPA] = .NEXTIN
; 0952 END
; 0953 ELSE
; 0954 BEGIN
; 0955 CPTR = .CPTR - 2^17;
; 0956 HLFTMP = .CNSWRK[.CPTR];
; 0957 NPTR = .HLFTMP[HLF_RGT];
; 0958 HLFTMP[HLF_RGT] = .NEXTIN;
; 0959 CNSWRK[.CPTR] = .HLFTMP
; 0960 END;
; 0961 CPTR = .NPTR
; 0962 END;
; 0963 LBLADR[.LPTR] = .NEXTIN
; 0964 END
; 0965 END;
DEFLBL: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC13,LBLCNT ; AC13,LBLCNT
MOVE AC14,SCALEN ; AC14,SCALEN
ADDI AC14,1 ; AC14,1
MOVE AC3,AC13 ; I,AC13
JRST L.78 ; L.78
L.77: MOVE AC5,C.3 ; HLF,[SCATOM]
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,AC14 ; AC1,AC14
MOVE AC2,LBLNAM(AC3) ; AC2,LBLNAM(I)
MOVE AC4,AC14 ; AC4,AC14
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.78 ; L.78
MOVE AC14,AC3 ; LPTR,I
JRST L.79 ; L.79
L.78: SOJGE AC3,L.77 ; I,L.77
SETO AC14, ; LPTR,
L.79: JUMPGE AC14,L.80 ; LPTR,L.80
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,DICT ; AC2,DICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
HRLI AC1,-337100 ; HLF,-337100
MOVEM AC1,LBLNAM(AC13) ; HLF,LBLNAM(AC13)
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,1 ; AC1,1
MOVE AC2,C.3 ; HLF,[SCATOM]
HRLI AC2,-337100 ; HLF,-337100
MOVE AC3,LBLCNT ; AC3,LBLCNT
MOVE AC4,AC1 ; AC4,AC1
MOVE AC5,LBLNAM(AC3) ; AC5,LBLNAM(AC3)
EXTEND AC1,C.12 ; AC1,[MOVSLJ ]
JFCL ;
MOVE AC1,NEXTIN ; AC1,NEXTIN
MOVEM AC1,LBLADR(AC3) ; AC1,LBLADR(AC3)
AOS LBLCNT ; LBLCNT
MOVEI AC1,24 ; AC1,24
CAML AC1,LBLCNT ; AC1,LBLCNT
JRST L.85 ; L.85
MOVEI AC1,CERM10 ; AC1,CERM10
PUSHJ SP,CERROR ; SP,CERROR
JRST L.85 ; L.85
L.80: MOVE AC1,LBLADR(AC14) ; AC1,LBLADR(LPTR)
JUMPGE AC1,L.85 ; AC1,L.85
MOVN AC1,AC1 ; CPTR,AC1
L.81: JUMPLE AC1,L.84 ; CPTR,L.84
CAML AC1,C.13 ; CPTR,[1000000]
JRST L.82 ; L.82
HRRZ AC3,CODWRK(AC1) ; NPTR,CODWRK(CPTR)
MOVE AC4,NEXTIN ; AC4,NEXTIN
HRRM AC4,CODWRK(AC1) ; AC4,CODWRK(CPTR)
JRST L.83 ; L.83
L.82: SUB AC1,C.13 ; CPTR,[1000000]
MOVE AC2,CNSWRK(AC1) ; HLFTMP,CNSWRK(CPTR)
MOVEI AC3,0(AC2) ; NPTR,0(HLFTMP)
HRR AC2,NEXTIN ; HLFTMP,NEXTIN
MOVEM AC2,CNSWRK(AC1) ; HLFTMP,CNSWRK(CPTR)
L.83: MOVE AC1,AC3 ; CPTR,NPTR
JRST L.81 ; L.81
L.84: MOVE AC1,NEXTIN ; AC1,NEXTIN
MOVEM AC1,LBLADR(AC14) ; AC1,LBLADR(LPTR)
L.85: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.12: MOVSLJ ;
C.13: EXP 1000000 ; 1000000
; Routine Size: 68 words
; 0966
; 0967 ROUTINE GENINS(OPR,OPA,OPB,OPC) = ! Generate an instruction
; 0968
; 0969 !++
; 0970 ! Functional description:
; 0971 ! Add an instruction in the code work area, with the given
; 0972 ! operation code and operand descriptors, and the current
; 0973 ! source line number. Steps the next-instruction
; 0974 ! index by 1 or 2 depending on the operation code.
; 0975 !
; 0976 ! Formal parameters:
; 0977 ! Operation code
; 0978 ! Three operand descriptors
; 0979 !
; 0980 ! Implicit inputs:
; 0981 ! Next instruction index
; 0982 !
; 0983 ! Implicit outputs:
; 0984 ! Code
; 0985 !
; 0986 ! Routine value:
; 0987 ! Index of code location of instruction
; 0988 !
; 0989 ! Side effects:
; 0990 ! None
; 0991 !
; 0992 !--
; 0993
; 0994 BEGIN
; 0995 EXTERNAL REGISTER Z=0;
; 0996 LOCAL
; 0997 PTR, ! Code pointers
; 0998 EPTR;
; 0999 PTR = .NEXTIN;
; 1000 IF .OPR LSS OPR_11W THEN EPTR = .PTR+2 ELSE EPTR = .PTR+1;
; 1001 IF .EPTR GEQ CODWKL THEN ERROR('Code work area full');
; 1002 CODWRK[.PTR,COD_VLD] = COD_VLD_NUM;
; 1003 CODWRK[.PTR,COD_LNO] = .SCALIN;
; 1004 CODWRK[.PTR,COD_OPR] = .OPR;
; 1005 CODWRK[.PTR,COD_OPA] = .OPA;
; 1006 IF .OPR LSS OPR_11W
; 1007 THEN
; 1008 (CODWRK[.PTR,COD_OPB] = .OPB;
; 1009 CODWRK[.PTR,COD_OPC] = .OPC);
; 1010 NEXTIN = .EPTR;
; 1011 .PTR
; 1012 END;
P.AEY: BYTE (7)"C","o","d","e"," " ; Code
BYTE (7)"w","o","r","k"," " ; work
BYTE (7)"a","r","e","a"," " ; area
BYTE (7)"f","u","l","l",000 ; full
GENINS: PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,2 ; SP,2
MOVEM AC4,0(SP) ; AC4,0(SP)
MOVEM AC3,-1(SP) ; AC3,-1(SP)
MOVE AC12,AC2 ; OPA,AC2
MOVE AC13,AC1 ; OPR,AC1
MOVE AC14,NEXTIN ; PTR,NEXTIN
SETZ AC10, ; AC10,
CAIL AC13,30 ; OPR,30
JRST L.86 ; L.86
MOVEI AC10,1 ; AC10,1
MOVE AC11,AC14 ; EPTR,PTR
ADDI AC11,2 ; EPTR,2
JRST L.87 ; L.87
L.86: MOVE AC11,AC14 ; EPTR,PTR
ADDI AC11,1 ; EPTR,1
L.87: CAIGE AC11,2000 ; EPTR,2000
JRST L.88 ; L.88
MOVEI AC1,P.AEY ; AC1,P.AEY
PUSHJ SP,CERROR ; SP,CERROR
L.88: MOVEI AC1,5 ; AC1,5
DPB AC1,C.14 ; AC1,[POINT 3,CODWRK(PTR),2] <33,3>
MOVE AC1,SCALIN ; AC1,SCALIN
DPB AC1,C.15 ; AC1,[POINT 9,CODWRK(PTR),11] <24,9>
DPB AC13,C.16 ; OPR,[POINT 6,CODWRK(PTR),17] <18,6>
HRRM AC12,CODWRK(AC14) ; OPA,CODWRK(PTR)
TRNN AC10,1 ; AC10,1
JRST L.89 ; L.89
MOVE AC1,-1(SP) ; AC1,-1(SP)
HRLM AC1,CODWRK+1(AC14) ; AC1,CODWRK+1(PTR)
MOVE AC1,0(SP) ; AC1,0(SP)
HRRM AC1,CODWRK+1(AC14) ; AC1,CODWRK+1(PTR)
L.89: MOVEM AC11,NEXTIN ; EPTR,NEXTIN
MOVE AC1,AC14 ; AC1,PTR
ADJSP SP,-2 ; SP,-2
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
C.14: POINT 3,CODWRK(AC14),2 ; 3,CODWRK(PTR),2
C.15: POINT 9,CODWRK(AC14),11 ; 9,CODWRK(PTR),11
C.16: POINT 6,CODWRK(AC14),17 ; 6,CODWRK(PTR),17
; Routine Size: 48 words
; 1013
; 1014 ROUTINE GETCNS(VALUE,TYPE)= ! Find/create constant
; 1015
; 1016 !++
; 1017 ! Functional description:
; 1018 ! Locates desired constant in constant pool work area, or
; 1019 ! creates it if not found. Returns constant table index.
; 1020 !
; 1021 ! Formal parameters:
; 1022 ! Value of constant (integer number or real stringvalue)
; 1023 ! Type of constant (STE_TYP)
; 1024 !
; 1025 ! Implicit inputs:
; 1026 ! None
; 1027 !
; 1028 ! Implicit outputs:
; 1029 ! Constant pool
; 1030 !
; 1031 ! Routine value:
; 1032 ! Index into constant pool
; 1033 !
; 1034 ! Side effects:
; 1035 ! None
; 1036 !
; 1037 !--
; 1038
; 1039 BEGIN
; 1040 EXTERNAL REGISTER Z=0;
; 1041 IF .TYPE EQL STE_TYP_INT
; 1042 THEN
; 1043 BEGIN
; 1044 DECR I FROM .CONSTP-1 DO
; 1045 IF .CNSWRK[.I] EQL .VALUE THEN RETURN .I;
; 1046 IF .CONSTP GEQ CNSWKL THEN CERROR(CERM1);
; 1047 CNSWRK[.CONSTP] = .VALUE;
; 1048 CONSTP = .CONSTP + 1;
; 1049 .CONSTP - 1
; 1050 END
; 1051 ELSE
; 1052 BEGIN
; 1053 MAP VALUE:STR_VAL;
; 1054 LOCAL
; 1055 LEN, ! String length
; 1056 PTR, ! String pointer
; 1057 SVAL: STR_VAL, ! String value of constant
; 1058 CPTR; ! Constant table pointer
; 1059 LABEL
; 1060 FOUND;
; 1061 LEN = .VALUE[STV_LEN];
; 1062 PTR = BYTPTR(.VALUE[STV_ADR]);
; 1063 CPTR =
; 1064 FOUND: BEGIN
; 1065 DECR I FROM .CONSTP-1 DO
; 1066 IF CH$EQL(.LEN+1,.PTR,.LEN+1,CH$PTR(CNSWRK[.I]))
; 1067 THEN
; 1068 LEAVE FOUND WITH .I;
; 1069 IF .CONSTP + (.LEN+5)/5 GTR CNSWKL
; 1070 THEN
; 1071 CERROR(CERM1);
; 1072 CH$COPY(.LEN,.PTR,0,.LEN+1,CH$PTR(CNSWRK[.CONSTP]));
; 1073 PTR = .CONSTP;
; 1074 CONSTP = .CONSTP + (.LEN+5)/5;
; 1075 .PTR
; 1076 END;
; 1077 SVAL[STV_ADR] = .CPTR;
; 1078 SVAL[STV_LEN] = .LEN;
; 1079 DECR I FROM .CONSTP-1 DO
; 1080 IF .CNSWRK[.I] EQL .SVAL THEN RETURN .I;
; 1081 IF .CONSTP GEQ CNSWKL THEN CERROR(CERM1);
; 1082 CPTR = .CONSTP;
; 1083 CNSWRK[.CPTR] = .SVAL;
; 1084 CONSTP = .CPTR + 1;
; 1085 .CPTR
; 1086 END
; 1087 END;
GETCNS: PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC13,AC1 ; VALUE,AC1
MOVE AC10,CONSTP ; AC10,CONSTP
MOVE AC14,AC10 ; AC14,AC10
SUBI AC14,1 ; AC14,1
JUMPN AC2,L.93 ; TYPE,L.93
MOVE AC2,AC14 ; I,AC14
AOJA AC2,L.91 ; I,L.91
L.90: CAMN AC13,CNSWRK(AC2) ; VALUE,CNSWRK(I)
JRST L.101 ; L.101
L.91: SOJGE AC2,L.90 ; I,L.90
CAIGE AC10,6000 ; AC10,6000
JRST L.92 ; L.92
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.92: MOVE AC1,CONSTP ; AC1,CONSTP
MOVEM AC13,CNSWRK(AC1) ; VALUE,CNSWRK(AC1)
AOS AC2,CONSTP ; AC2,CONSTP
SOJA AC2,L.101 ; AC2,L.101
L.93: HLRZ AC12,AC13 ; LEN,VALUE
MOVEI AC1,0(AC13) ; HLF,0(VALUE)
HRLI AC1,-337100 ; HLF,-337100
MOVE AC11,AC1 ; PTR,HLF
MOVE AC13,AC12 ; AC13,LEN
ADDI AC13,1 ; AC13,1
MOVE AC3,AC14 ; I,AC14
AOJA AC3,L.95 ; I,L.95
L.94: MOVEI AC5,CNSWRK-1(AC3) ; AC5,CNSWRK-1(I)
HRLI AC5,10700 ; AC5,10700
MOVE AC1,AC13 ; AC1,AC13
MOVE AC2,AC11 ; AC2,PTR
MOVE AC4,AC13 ; AC4,AC13
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.95 ; L.95
MOVE AC14,AC3 ; CPTR,I
JRST L.97 ; L.97
L.95: SOJGE AC3,L.94 ; I,L.94
MOVE AC14,AC12 ; AC14,LEN
ADDI AC14,5 ; AC14,5
MOVE AC1,AC14 ; AC1,AC14
IDIVI AC1,5 ; AC1,5
MOVE AC14,AC1 ; AC14,AC1
MOVE AC2,AC10 ; AC2,AC10
ADD AC2,AC14 ; AC2,AC14
CAIG AC2,6000 ; AC2,6000
JRST L.96 ; L.96
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.96: MOVE AC3,CONSTP ; AC3,CONSTP
MOVEI AC5,CNSWRK-1(AC3) ; AC5,CNSWRK-1(AC3)
HRLI AC5,10700 ; AC5,10700
MOVE AC1,AC12 ; AC1,LEN
MOVE AC2,AC11 ; AC2,PTR
MOVE AC4,AC13 ; AC4,AC13
EXTEND AC1,C.8 ; AC1,C.8
JFCL ;
MOVE AC11,AC3 ; PTR,AC3
ADDM AC14,CONSTP ; AC14,CONSTP
MOVE AC14,AC11 ; CPTR,PTR
L.97: HRR AC13,AC14 ; SVAL,CPTR
HRL AC13,AC12 ; SVAL,LEN
MOVE AC2,CONSTP ; AC2,CONSTP
MOVE AC1,AC2 ; I,AC2
JRST L.99 ; L.99
L.98: CAMN AC13,CNSWRK(AC1) ; SVAL,CNSWRK(I)
JRST L.102 ; L.102
L.99: SOJGE AC1,L.98 ; I,L.98
CAIGE AC2,6000 ; AC2,6000
JRST L.100 ; L.100
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.100: MOVE AC14,CONSTP ; CPTR,CONSTP
MOVEM AC13,CNSWRK(AC14) ; SVAL,CNSWRK(CPTR)
MOVE AC1,AC14 ; AC1,CPTR
ADDI AC1,1 ; AC1,1
MOVEM AC1,CONSTP ; AC1,CONSTP
MOVE AC2,AC14 ; AC2,CPTR
L.101: MOVE AC1,AC2 ; AC1,AC2
L.102: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
; Routine Size: 88 words
; 1088
; 1089 ROUTINE ASMPRC: NOVALUE = ! Assemble components
; 1090
; 1091 !++
; 1092 ! Functional description:
; 1093 ! Merge the parameter list, constant pool, and symbol table into
; 1094 ! the code work area, find the total length of the procedure text,
; 1095 ! allocate space for it in the text region, copy into the text region the
; 1096 ! procedure's text. Leaves assorted information around to be
; 1097 ! entered into global symbol table.
; 1098 !
; 1099 ! Formal parameters:
; 1100 ! None
; 1101 !
; 1102 ! Implicit inputs:
; 1103 ! Code, arguments, constants, symbols
; 1104 !
; 1105 ! Implicit outputs:
; 1106 ! Text area
; 1107 !
; 1108 ! Routine value:
; 1109 ! None
; 1110 !
; 1111 ! Side effects:
; 1112 ! None
; 1113 !
; 1114 !--
; 1115
; 1116 BEGIN
; 1117 EXTERNAL REGISTER Z=0;
; 1118 MAP
; 1119 SYMWRK: VECTOR; ! Simpler access
; 1120 LOCAL
; 1121 PTRI, ! Copy pointers
; 1122 PTRO;
; 1123 CURTXT = PCMGMM(.NEXTIN+.PRCARG[0]+.CONSTP+.SYMTBP*STE_LEN, PCTXFR);
; 1124 IF .CURTXT LEQ 0 THEN ERROR('Out of text space');
; 1125 PTRI = CODWRK;
; 1126 PTRO = .CURTXT;
; 1127 DECR I FROM .NEXTIN-1 DO
; 1128 BEGIN
; 1129 .PTRO = ..PTRI;
; 1130 PTRI = .PTRI + 1;
; 1131 PTRO = .PTRO + 1
; 1132 END;
; 1133 PTRI = PRCARG[1];
; 1134 DECR I FROM .PRCARG[0]-1 DO
; 1135 BEGIN
; 1136 .PTRO = ..PTRI;
; 1137 PTRI = .PTRI + 1;
; 1138 PTRO = .PTRO + 1
; 1139 END;
; 1140 PTRI = CNSWRK;
; 1141 DECR I FROM .CONSTP-1 DO
; 1142 BEGIN
; 1143 .PTRO = ..PTRI;
; 1144 PTRI = .PTRI + 1;
; 1145 PTRO = .PTRO + 1
; 1146 END;
; 1147 PTRI = SYMWRK;
; 1148 DECR I FROM (.SYMTBP*STE_LEN)-1 DO
; 1149 BEGIN
; 1150 .PTRO = ..PTRI;
; 1151 PTRI = .PTRI + 1;
; 1152 PTRO = .PTRO + 1
; 1153 END
; 1154 END;
P.AEZ: BYTE (7)"O","u","t"," ","o" ; Out o
BYTE (7)"f"," ","t","e","x" ; f tex
BYTE (7)"t"," ","s","p","a" ; t spa
BYTE (7)"c","e",000,000,000 ; ce
ASMPRC: MOVE AC1,NEXTIN ; AC1,NEXTIN
ADD AC1,PRCARG ; AC1,PRCARG
ADD AC1,CONSTP ; AC1,CONSTP
MOVE AC2,SYMTBP ; AC2,SYMTBP
IMULI AC2,2 ; AC2,2
ADD AC1,AC2 ; AC1,AC2
MOVEI AC2,PCTXFR ; AC2,PCTXFR
PUSHJ SP,PCMGMM ; SP,PCMGMM
MOVEM AC1,CURTXT ; AC1,CURTXT
SKIPLE CURTXT ; CURTXT
JRST L.103 ; L.103
MOVEI AC1,P.AEZ ; AC1,P.AEZ
PUSHJ SP,CERROR ; SP,CERROR
L.103: MOVEI AC1,CODWRK ; PTRI,CODWRK
MOVE AC3,CURTXT ; PTRO,CURTXT
MOVE AC2,NEXTIN ; I,NEXTIN
JRST L.105 ; L.105
L.104: MOVE AC4,0(AC1) ; AC4,0(PTRI)
MOVEM AC4,0(AC3) ; AC4,0(PTRO)
ADDI AC1,1 ; PTRI,1
ADDI AC3,1 ; PTRO,1
L.105: SOJGE AC2,L.104 ; I,L.104
MOVE AC1,C.17 ; PTRI,[PRCARG+1]
MOVE AC2,PRCARG ; I,PRCARG
JRST L.107 ; L.107
L.106: MOVE AC4,0(AC1) ; AC4,0(PTRI)
MOVEM AC4,0(AC3) ; AC4,0(PTRO)
ADDI AC1,1 ; PTRI,1
ADDI AC3,1 ; PTRO,1
L.107: SOJGE AC2,L.106 ; I,L.106
MOVE AC1,C.9 ; PTRI,[CNSWRK]
MOVE AC2,CONSTP ; I,CONSTP
JRST L.109 ; L.109
L.108: MOVE AC4,0(AC1) ; AC4,0(PTRI)
MOVEM AC4,0(AC3) ; AC4,0(PTRO)
ADDI AC1,1 ; PTRI,1
ADDI AC3,1 ; PTRO,1
L.109: SOJGE AC2,L.108 ; I,L.108
MOVE AC1,C.18 ; PTRI,[SYMWRK]
MOVE AC2,SYMTBP ; AC2,SYMTBP
IMULI AC2,2 ; AC2,2
JRST L.111 ; L.111
L.110: MOVE AC4,0(AC1) ; AC4,0(PTRI)
MOVEM AC4,0(AC3) ; AC4,0(PTRO)
ADDI AC1,1 ; PTRI,1
ADDI AC3,1 ; PTRO,1
L.111: SOJGE AC2,L.110 ; I,L.110
POPJ SP, ; SP,
C.17: EXP PRCARG+1 ; PRCARG+1
C.18: EXP SYMWRK ; SYMWRK
; Routine Size: 50 words
; 1155
; 1156 ROUTINE DEFPRC: NOVALUE = ! Define procedure
; 1157
; 1158 !++
; 1159 ! Functional description:
; 1160 ! Creates global symbol table entry for newly-compiled routine.
; 1161 !
; 1162 ! Formal parameters:
; 1163 ! None
; 1164 !
; 1165 ! Implicit inputs:
; 1166 ! Key indices describing lengths of various objects
; 1167 !
; 1168 ! Implicit outputs:
; 1169 ! Global symbol table
; 1170 !
; 1171 ! Routine value:
; 1172 ! None
; 1173 !
; 1174 ! Side effects:
; 1175 ! None
; 1176 !
; 1177 !--
; 1178
; 1179 BEGIN
; 1180 EXTERNAL REGISTER Z=0;
; 1181 LOCAL
; 1182 GS:BLOCK[GST_LEN] FIELD (GST_FLD); ! A global symbol entry
; 1183 GS[GST_CLS] = .CURCLS;
; 1184 IF .CURCLS EQL GST_CLS_CMD
; 1185 THEN
; 1186 GS[GST_CMA] = .CMDARG
; 1187 ELSE
; 1188 GS[GST_PCT] = .PRCARG[0];
; 1189 IF .CURCLS EQL GST_CLS_FCN THEN GS[GST_TYP] = .CURTYP;
; 1190 GS[GST_SLN] = .NUMVRS;
; 1191 GS[GST_TXT] = .CURTXT;
; 1192 GS[GST_COD] = .NEXTIN;
; 1193 GS[GST_CNS] = .CONSTP;
; 1194 GS[GST_SML] = .SYMTBP;
; 1195 GS[GST_NML] = .CURNML;
; 1196 GS[GST_NMA] = GTBUFX(((.CURNML+5)/5));
; 1197 CH$COPY(.CURNML, CH$PTR(CURRTN), 0, .CURNML+1, BYTPTR(.GS[GST_NMA]));
; 1198 PCICGS(GS)
; 1199 END;
DEFPRC: ADJSP SP,3 ; SP,3
MOVE AC1,CURCLS ; AC1,CURCLS
DPB AC1,C.19 ; AC1,[POINT 3,GS,4] <31,3>
JUMPN AC1,L.112 ; AC1,L.112
SKIPA AC2,CMDARG ; AC2,CMDARG
L.112: MOVE AC2,PRCARG ; AC2,PRCARG
DPB AC2,C.20 ; AC2,[POINT 4,GS,9] <26,4>
CAIE AC1,3 ; AC1,3
JRST L.113 ; L.113
MOVE AC1,CURTYP ; AC1,CURTYP
DPB AC1,C.21 ; AC1,[POINT 1,GS,5] <30,1>
L.113: MOVE AC1,NUMVRS ; AC1,NUMVRS
DPB AC1,C.22 ; AC1,[POINT 8,GS,17] <18,8>
MOVE AC1,CURTXT ; AC1,CURTXT
HRRM AC1,-2(SP) ; AC1,GS
MOVE AC1,NEXTIN ; AC1,NEXTIN
DPB AC1,C.23 ; AC1,[POINT 12,GS+1,35] <0,12>
MOVE AC1,CONSTP ; AC1,CONSTP
DPB AC1,C.24 ; AC1,[POINT 12,GS+1,23] <12,12>
MOVE AC1,SYMTBP ; AC1,SYMTBP
DPB AC1,C.25 ; AC1,[POINT 12,GS+1,11] <24,12>
MOVE AC1,CURNML ; AC1,CURNML
HRLM AC1,0(SP) ; AC1,GS+2
MOVE AC1,CURNML ; AC1,CURNML
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
PUSHJ SP,GTBUFX ; SP,GTBUFX
HRRM AC1,0(SP) ; AC1,GS+2
MOVE AC4,CURNML ; AC4,CURNML
ADDI AC4,1 ; AC4,1
HRRZ AC5,0(SP) ; HLF,GS+2
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,CURNML ; AC1,CURNML
MOVE AC2,C.26 ; AC2,[POINT 7,BUF0+10777,34] <1,7>
EXTEND AC1,C.8 ; AC1,C.8
JFCL ;
MOVEI AC1,-2(SP) ; AC1,GS
PUSHJ SP,PCICGS ; SP,PCICGS
ADJSP SP,-3 ; SP,-3
POPJ SP, ; SP,
C.19: POINT 3,-2(SP),4 ; 3,GS,4
C.20: POINT 4,-2(SP),9 ; 4,GS,9
C.21: POINT 1,-2(SP),5 ; 1,GS,5
C.22: POINT 8,-2(SP),17 ; 8,GS,17
C.23: POINT 12,-1(SP),35 ; 12,GS+1,35
C.24: POINT 12,-1(SP),23 ; 12,GS+1,23
C.25: POINT 12,-1(SP),11 ; 12,GS+1,11
C.26: POINT 7,BUF0+10777,34 ; 7,BUF0+10777,34
; Routine Size: 48 words
; 1200
; 1201 GLOBAL ROUTINE PCCCPL(CPLPTR): NOVALUE = ! Main routine
; 1202
; 1203 !++
; 1204 ! Functional description:
; 1205 ! Defines a sequence of commands, procedures, and global variables,
; 1206 ! from source string provided by caller.
; 1207 !
; 1208 ! Formal parameters:
; 1209 ! Pointer to ASCIZ source string
; 1210 !
; 1211 ! Implicit inputs:
; 1212 ! The source
; 1213 !
; 1214 ! Implicit outputs:
; 1215 ! Text region, global symbol table, the three work areas
; 1216 !
; 1217 ! Routine value:
; 1218 ! None
; 1219 !
; 1220 ! Side effects:
; 1221 ! None
; 1222 !
; 1223 !--
; 1224
; 1225 BEGIN
; 1226 EXTERNAL REGISTER Z=0;
; 1227 SCAPTR = .CPLPTR;
; 1228 LLNPTR = .SCAPTR;
; 1229 SCATRP = 0;
; 1230 SCALIN = 1;
; 1231 SCAN();
; 1232 DO
; 1233 BEGIN
; 1234 SELECTONE .SCACOD OF
; 1235 SET
; 1236 [SCN_COMMAND]: CURCLS = GST_CLS_CMD;
; 1237 [SCN_INTEGER,
; 1238 SCN_STRING]: BEGIN
; 1239 CURTYP =
; 1240 (IF .SCACOD EQL SCN_INTEGER THEN GST_TYP_INT ELSE GST_TYP_STR);
; 1241 IF SCAN() EQL SCN_PROCEDURE
; 1242 THEN
; 1243 CURCLS = GST_CLS_FCN
; 1244 ELSE
; 1245 IF .SCACOD EQL SCN_IDENT
; 1246 THEN
; 1247 CURCLS = GST_CLS_VAR
; 1248 ELSE
; 1249 ERROR('PROCEDURE or variable name missing')
; 1250 END;
; 1251 [SCN_PROCEDURE]:
; 1252 CURCLS = GST_CLS_PRC;
; 1253 [SCN_SYNONYM,
; 1254 SCN_NOORIGINAL]:
; 1255 BEGIN
; 1256 CURCLS = GST_CLS_SYN;
; 1257 CURTYP = (IF .SCACOD EQL SCN_SYNONYM THEN 0 ELSE 1)
; 1258 END;
; 1259 [OTHERWISE]: ERROR('Unable to recognize definition')
; 1260 TES;
; 1261 SELECTONE .CURCLS OF
; 1262 SET
; 1263 [GST_CLS_VAR]: CPVARD();
; 1264 [GST_CLS_SYN]: CPSYND();
; 1265 [OTHERWISE]: CPCMPL()
; 1266 TES;
; 1267 IF .SCACOD EQL SCN_SEMI THEN SCAN()
; 1268 END
; 1269 UNTIL
; 1270 .SCACOD EQL SCN_EOFILE
; 1271 END;
P.AFA: BYTE (7)"P","R","O","C","E" ; PROCE
BYTE (7)"D","U","R","E"," " ; DURE
BYTE (7)"o","r"," ","v","a" ; or va
BYTE (7)"r","i","a","b","l" ; riabl
BYTE (7)"e"," ","n","a","m" ; e nam
BYTE (7)"e"," ","m","i","s" ; e mis
BYTE (7)"s","i","n","g",000 ; sing
P.AFB: BYTE (7)"U","n","a","b","l" ; Unabl
BYTE (7)"e"," ","t","o"," " ; e to
BYTE (7)"r","e","c","o","g" ; recog
BYTE (7)"n","i","z","e"," " ; nize
BYTE (7)"d","e","f","i","n" ; defin
BYTE (7)"i","t","i","o","n" ; ition
BYTE (7)000,000,000,000,000
PCCCPL::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVEM AC1,SCAPTR ; CPLPTR,SCAPTR
MOVEM AC1,LLNPTR ; AC1,LLNPTR
SETZM SCATRP ; SCATRP
MOVEI AC1,1 ; AC1,1
MOVEM AC1,SCALIN ; AC1,SCALIN
PUSHJ SP,SCAN ; SP,SCAN
MOVE AC13,SCACOD ; AC13,SCACOD
L.114: CAIE AC13,26 ; AC13,26
JRST L.115 ; L.115
SETZM CURCLS ; CURCLS
JRST L.123 ; L.123
L.115: CAIL AC13,34 ; AC13,34
CAILE AC13,35 ; AC13,35
JRST L.118 ; L.118
CAIN AC13,34 ; AC13,34
TDZA AC1,AC1 ; AC1,AC1
MOVEI AC1,1 ; AC1,1
MOVEM AC1,CURTYP ; AC1,CURTYP
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,25 ; AC1,25
JRST L.116 ; L.116
MOVEI AC1,3 ; AC1,3
JRST L.119 ; L.119
L.116: MOVEI AC1,1 ; AC1,1
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.117 ; L.117
MOVEI AC1,2 ; AC1,2
JRST L.119 ; L.119
L.117: MOVEI AC1,P.AFA ; AC1,P.AFA
JRST L.122 ; L.122
L.118: CAIE AC13,25 ; AC13,25
JRST L.120 ; L.120
MOVEI AC1,1 ; AC1,1
L.119: MOVEM AC1,CURCLS ; AC1,CURCLS
JRST L.123 ; L.123
L.120: CAIL AC13,27 ; AC13,27
CAILE AC13,30 ; AC13,30
JRST L.121 ; L.121
MOVEI AC1,4 ; AC1,4
MOVEM AC1,CURCLS ; AC1,CURCLS
MOVEI AC1,27 ; AC1,27
CAMN AC1,SCACOD ; AC1,SCACOD
TDZA AC1,AC1 ; AC1,AC1
MOVEI AC1,1 ; AC1,1
MOVEM AC1,CURTYP ; AC1,CURTYP
JRST L.123 ; L.123
L.121: MOVEI AC1,P.AFB ; AC1,P.AFB
L.122: PUSHJ SP,CERROR ; SP,CERROR
L.123: MOVE AC14,CURCLS ; AC14,CURCLS
CAIE AC14,2 ; AC14,2
JRST L.124 ; L.124
PUSHJ SP,CPVARD ; SP,CPVARD
JRST L.126 ; L.126
L.124: CAIE AC14,4 ; AC14,4
JRST L.125 ; L.125
PUSHJ SP,CPSYND ; SP,CPSYND
JRST L.126 ; L.126
L.125: PUSHJ SP,CPCMPL ; SP,CPCMPL
L.126: MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
PUSHJ SP,SCAN ; SP,SCAN
MOVE AC13,SCACOD ; AC13,SCACOD
CAIE AC13,132 ; AC13,132
JRST L.114 ; L.114
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 69 words
; 1272
; 1273 ROUTINE CPVARD: NOVALUE = ! Define a variable
; 1274
; 1275 !++
; 1276 ! Functional description:
; 1277 ! Defines a global variable.
; 1278 !
; 1279 ! Formal parameters:
; 1280 ! None
; 1281 !
; 1282 ! Implicit inputs:
; 1283 ! Source file, CURTYP
; 1284 !
; 1285 ! Implicit outputs:
; 1286 ! Global symbol table
; 1287 !
; 1288 ! Routine value:
; 1289 ! None
; 1290 !
; 1291 ! Side effects:
; 1292 ! Scans past variable name
; 1293 !
; 1294 !--
; 1295
; 1296 BEGIN
; 1297 EXTERNAL REGISTER Z=0;
; 1298 PCIDFV(.SCALEN^18 + SCATOM, (IF .CURTYP EQL GST_TYP_INT THEN 0 ELSE -1));
; 1299 SCAN()
; 1300 END;
CPVARD: HRLZ AC1,SCALEN ; AC1,SCALEN
ADD AC1,C.3 ; AC1,[SCATOM]
SKIPN CURTYP ; CURTYP
TDZA AC2,AC2 ; AC2,AC2
SETO AC2, ; AC2,
PUSHJ SP,PCIDFV ; SP,PCIDFV
JRST SCAN ; SCAN
; Routine Size: 7 words
; 1301
; 1302 ROUTINE CPSYND: NOVALUE = ! Define a synonym
; 1303
; 1304 !++
; 1305 ! Functional description:
; 1306 ! Defines a synonym or removed original command.
; 1307 !
; 1308 ! Formal parameters:
; 1309 ! None
; 1310 !
; 1311 ! Implicit inputs:
; 1312 ! Source file, CURTYP
; 1313 !
; 1314 ! Implicit outputs:
; 1315 ! Global symbol table
; 1316 !
; 1317 ! Routine value:
; 1318 ! None
; 1319 !
; 1320 ! Side effects:
; 1321 ! Scans to unrecognized atom
; 1322 !
; 1323 !--
; 1324
; 1325 BEGIN
; 1326 EXTERNAL REGISTER Z=0;
; 1327 LOCAL
; 1328 NAME: VECTOR[8], ! Command name
; 1329 NAMVAL: STR_VAL, ! Stringvalue of it
; 1330 NAMLEN, ! Its length
; 1331 PTRI, ! Character pointers
; 1332 PTRO,
; 1333 CHR;
; 1334 SCATRP = -1;
; 1335 IF SCAN() NEQ SCN_IDENT THEN ERROR('Command name not found');
; 1336 PTRI = BYTPTR(SCATOM);
; 1337 PTRO = BYTPTR(NAME);
; 1338 DO
; 1339 BEGIN
; 1340 CHR = CH$RCHAR_A(PTRI);
; 1341 IF .CHR GEQ %C'a' AND .CHR LEQ %C'z' THEN CHR = .CHR - %C'a' + %C'A';
; 1342 IF .CHR EQL %C'_' THEN CHR = %C'-';
; 1343 CH$WCHAR_A(.CHR,PTRO)
; 1344 END
; 1345 UNTIL
; 1346 .CHR EQL $CHNUL;
; 1347 NAMVAL[STV_ADR] = NAME;
; 1348 NAMVAL[STV_LEN] = .SCALEN;
; 1349 IF .CURTYP EQL 0
; 1350 THEN
; 1351 BEGIN
; 1352 IF SCAN() NEQ SCN_IDENT THEN ERROR('Old command name missing');
; 1353 PTRI = PTRO = BYTPTR(SCATOM);
; 1354 DO
; 1355 BEGIN
; 1356 CHR = CH$RCHAR_A(PTRI);
; 1357 IF .CHR EQL %C'_' THEN CHR = %C'-';
; 1358 CH$WCHAR_A(.CHR,PTRO)
; 1359 END
; 1360 UNTIL
; 1361 .CHR EQL $CHNUL
; 1362 END;
; 1363 SCATRP = 0;
; 1364 PCIDFS(.NAMVAL, (IF .CURTYP EQL 0 THEN SCATOM ELSE 0));
; 1365 SCAN()
; 1366 END;
P.AFC: BYTE (7)"C","o","m","m","a" ; Comma
BYTE (7)"n","d"," ","n","a" ; nd na
BYTE (7)"m","e"," ","n","o" ; me no
BYTE (7)"t"," ","f","o","u" ; t fou
BYTE (7)"n","d",000,000,000 ; nd
P.AFD: BYTE (7)"O","l","d"," ","c" ; Old c
BYTE (7)"o","m","m","a","n" ; omman
BYTE (7)"d"," ","n","a","m" ; d nam
BYTE (7)"e"," ","m","i","s" ; e mis
BYTE (7)"s","i","n","g",000 ; sing
CPSYND: PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,10 ; SP,10
SETOM SCATRP ; SCATRP
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.127 ; L.127
MOVEI AC1,P.AFC ; AC1,P.AFC
PUSHJ SP,CERROR ; SP,CERROR
L.127: MOVE AC1,C.3 ; HLF,[SCATOM]
HRLI AC1,-337100 ; HLF,-337100
MOVE AC11,AC1 ; PTRI,HLF
MOVEI AC1,-7(SP) ; HLF,NAME
HRLI AC1,-337100 ; HLF,-337100
MOVE AC13,AC1 ; PTRO,HLF
L.128: ILDB AC14,AC11 ; CHR,PTRI
CAIL AC14,141 ; CHR,141
CAILE AC14,172 ; CHR,172
JRST L.129 ; L.129
SUBI AC14,40 ; CHR,40
L.129: CAIN AC14,137 ; CHR,137
MOVEI AC14,55 ; CHR,55
IDPB AC14,AC13 ; CHR,PTRO
JUMPN AC14,L.128 ; CHR,L.128
MOVEI AC1,-7(SP) ; AC1,NAME
HRR AC12,AC1 ; NAMVAL,AC1
HRL AC12,SCALEN ; NAMVAL,SCALEN
SKIPE CURTYP ; CURTYP
JRST L.132 ; L.132
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.130 ; L.130
MOVEI AC1,P.AFD ; AC1,P.AFD
PUSHJ SP,CERROR ; SP,CERROR
L.130: MOVE AC1,C.3 ; HLF,[SCATOM]
HRLI AC1,-337100 ; HLF,-337100
MOVE AC13,AC1 ; PTRO,HLF
MOVE AC11,AC1 ; PTRI,HLF
L.131: ILDB AC14,AC11 ; CHR,PTRI
CAIN AC14,137 ; CHR,137
MOVEI AC14,55 ; CHR,55
IDPB AC14,AC13 ; CHR,PTRO
JUMPN AC14,L.131 ; CHR,L.131
L.132: SETZM SCATRP ; SCATRP
SKIPN CURTYP ; CURTYP
SKIPA AC2,C.3 ; AC2,[SCATOM]
SETZ AC2, ; AC2,
MOVE AC1,AC12 ; AC1,NAMVAL
PUSHJ SP,PCIDFS ; SP,PCIDFS
PUSHJ SP,SCAN ; SP,SCAN
ADJSP SP,-10 ; SP,-10
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POPJ SP, ; SP,
; Routine Size: 58 words
; 1367
; 1368 ROUTINE CPCMPL: NOVALUE = ! Define a routine
; 1369
; 1370 !++
; 1371 ! Functional description:
; 1372 ! Compiles a command or procedure into temporary work areas defined
; 1373 ! in EXECDE. It then merges the generated code, constants, and
; 1374 ! symbol table into the text region, and creates the global symbol
; 1375 ! entry for the routine.
; 1376 !
; 1377 ! Formal parameters:
; 1378 ! None
; 1379 !
; 1380 ! Implicit inputs:
; 1381 ! The source, CURCLS, CURTYP
; 1382 !
; 1383 ! Implicit outputs:
; 1384 ! Text, global symbol table
; 1385 !
; 1386 ! Routine value:
; 1387 ! None
; 1388 !
; 1389 ! Side effects:
; 1390 ! Scans from routine name to after last atom of routine
; 1391 !
; 1392 !--
; 1393
; 1394 BEGIN
; 1395 EXTERNAL REGISTER Z=0;
; 1396 LOCAL
; 1397 GS: REF GST_BLK; ! GST entry
; 1398 NEXTIN = 0;
; 1399 SCATRP = 0;
; 1400 CONSTP = 0;
; 1401 SYMTBP = 0;
; 1402 CURNML = 0;
; 1403 PRCARG[0] = 0;
; 1404 CMDARG = -1;
; 1405 NUMVRS = 0;
; 1406 LBLCNT = 0;
; 1407 CPRTNC(); ! Compile the routine
; 1408 GENINS(OPR_RET,0,0,0); ! Provide a free RET
; 1409 ASMPRC(); ! Assemble the components into text region
; 1410 DEFPRC() ! Define in global symbol table
; 1411 END;
CPCMPL: SETZM NEXTIN ; NEXTIN
SETZM SCATRP ; SCATRP
SETZM CONSTP ; CONSTP
SETZM SYMTBP ; SYMTBP
SETZM CURNML ; CURNML
SETZM PRCARG ; PRCARG
SETOM CMDARG ; CMDARG
SETZM NUMVRS ; NUMVRS
SETZM LBLCNT ; LBLCNT
PUSHJ SP,CPRTNC ; SP,CPRTNC
MOVEI AC1,31 ; AC1,31
SETZB AC2,AC3 ; AC2,AC3
SETZ AC4, ; AC4,
PUSHJ SP,GENINS ; SP,GENINS
PUSHJ SP,ASMPRC ; SP,ASMPRC
JRST DEFPRC ; DEFPRC
; Routine Size: 16 words
; 1412
; 1413 ROUTINE CPRTNC: NOVALUE = ! <Procedure-declaration>
; 1414
; 1415 !++
; 1416 ! Functional description:
; 1417 ! Compile one command, procedure or function. Find routine name, proces
; 1418 ! any formal parameter list, do routine body, do final label
; 1419 ! processing.
; 1420 !
; 1421 ! Formal parameters:
; 1422 ! None
; 1423 !
; 1424 ! Implicit inputs:
; 1425 ! Source, label table
; 1426 !
; 1427 ! Implicit outputs:
; 1428 ! Routine name, class, type
; 1429 !
; 1430 ! Routine value:
; 1431 ! None
; 1432 !
; 1433 ! Side effects:
; 1434 ! Scans from routine name to unrecognized atom
; 1435 !
; 1436 !--
; 1437
; 1438 BEGIN
; 1439 EXTERNAL REGISTER Z=0;
; 1440 SCATRP = -1;
; 1441 IF SCAN() NEQ SCN_IDENT THEN CERROR(CERM3);
; 1442 SCATRP = 0;
; 1443 CURNML = .SCALEN;
; 1444 CH$MOVE(.SCALEN, CH$PTR(SCATOM), CH$PTR(CURRTN));
; 1445 IF .CURCLS EQL GST_CLS_CMD
; 1446 THEN
; 1447 BEGIN
; 1448 LOCAL PTR;
; 1449 PTR = CH$PTR(CURRTN);
; 1450 DECR I FROM .SCALEN-1 DO
; 1451 IF CH$RCHAR_A(PTR) EQL %C'_' THEN CH$WCHAR(%C'-',CH$PLUS(.PTR,-1))
; 1452 END;
; 1453 IF SCAN() EQL SCN_LPAREN
; 1454 THEN
; 1455 BEGIN
; 1456 IF .CURCLS EQL GST_CLS_CMD THEN CPCARG() ELSE CPFRML();
; 1457 IF .SCACOD NEQ SCN_RPAREN THEN CERROR(CERM6);
; 1458 SCAN()
; 1459 END;
; 1460 IF .SCACOD NEQ SCN_SEMI THEN CERROR(CERM6);
; 1461 SCAN();
; 1462 CPBODY();
; 1463 DECR I FROM .LBLCNT-1 DO
; 1464 IF .LBLADR[.I] LSS 0
; 1465 THEN
; 1466 BEGIN
; 1467 LOCAL
; 1468 STR: STR_VAL;
; 1469 STR = .LBLNAM[.I];
; 1470 CERROR( UPLIT(%ASCIZ 'Label #1 left undefined'), .STR[STV_ADR])
; 1471 END
; 1472 END;
P.AFE: BYTE (7)"L","a","b","e","l" ; Label
BYTE (7)" ","#","1"," ","l" ; #1 l
BYTE (7)"e","f","t"," ","u" ; eft u
BYTE (7)"n","d","e","f","i" ; ndefi
BYTE (7)"n","e","d",000,000 ; ned
CPRTNC: PUSH SP,AC14 ; SP,AC14
SETOM SCATRP ; SCATRP
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.133 ; L.133
MOVEI AC1,CERM3 ; AC1,CERM3
PUSHJ SP,CERROR ; SP,CERROR
L.133: SETZM SCATRP ; SCATRP
MOVE AC1,SCALEN ; AC1,SCALEN
MOVEM AC1,CURNML ; AC1,CURNML
MOVE AC1,SCALEN ; AC1,SCALEN
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
MOVE AC4,SCALEN ; AC4,SCALEN
MOVE AC5,C.26 ; AC5,[POINT 7,BUF0+10777,34] <1,7>
EXTEND AC1,C.12 ; AC1,[MOVSLJ ]
JFCL ;
SKIPE CURCLS ; CURCLS
JRST L.136 ; L.136
MOVE AC3,C.26 ; PTR,[POINT 7,BUF0+10777,34] <1,7>
MOVE AC4,SCALEN ; I,SCALEN
JRST L.135 ; L.135
L.134: ILDB AC1,AC3 ; AC1,PTR
CAIE AC1,137 ; AC1,137
JRST L.135 ; L.135
MOVEI AC2,55 ; AC2,55
SETO AC1, ; AC1,
ADJBP AC1,AC3 ; AC1,PTR
IDPB AC2,AC1 ; AC2,AC1
L.135: SOJGE AC4,L.134 ; I,L.134
L.136: PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,16 ; AC1,16
JRST L.140 ; L.140
SKIPE CURCLS ; CURCLS
JRST L.137 ; L.137
PUSHJ SP,CPCARG ; SP,CPCARG
JRST L.138 ; L.138
L.137: PUSHJ SP,CPFRML ; SP,CPFRML
L.138: MOVEI AC1,17 ; AC1,17
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.139 ; L.139
MOVEI AC1,CERM6 ; AC1,CERM6
PUSHJ SP,CERROR ; SP,CERROR
L.139: PUSHJ SP,SCAN ; SP,SCAN
L.140: MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.141 ; L.141
MOVEI AC1,CERM6 ; AC1,CERM6
PUSHJ SP,CERROR ; SP,CERROR
L.141: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPBODY ; SP,CPBODY
MOVE AC14,LBLCNT ; I,LBLCNT
JRST L.143 ; L.143
L.142: SKIPL LBLADR(AC14) ; LBLADR(I)
JRST L.143 ; L.143
MOVE AC3,LBLNAM(AC14) ; STR,LBLNAM(I)
MOVEI AC1,P.AFE ; AC1,P.AFE
MOVEI AC2,0(AC3) ; AC2,0(STR)
PUSHJ SP,CERROR ; SP,CERROR
L.143: SOJGE AC14,L.142 ; I,L.142
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 61 words
; 1473
; 1474 ROUTINE CPFRML: NOVALUE = ! <Formal-parameter-list>
; 1475
; 1476 !++
; 1477 ! Functional description:
; 1478 ! Called from <Procedure-declaration> to compile formal parameter
; 1479 ! list. Builds parameter list into PRCARG.
; 1480 !
; 1481 ! Formal parameters:
; 1482 ! None
; 1483 !
; 1484 ! Implicit inputs:
; 1485 ! Source
; 1486 !
; 1487 ! Implicit outputs:
; 1488 ! PRCARG
; 1489 !
; 1490 ! Routine value:
; 1491 ! None
; 1492 !
; 1493 ! Side effects:
; 1494 ! Scans from ( to )
; 1495 !
; 1496 !--
; 1497
; 1498 BEGIN
; 1499 EXTERNAL REGISTER Z=0;
; 1500 LOCAL
; 1501 STE, ! Symbol table index of parameter
; 1502 TYP; ! Type of parameter
; 1503 DO
; 1504 BEGIN
; 1505 TYP = SCAN();
; 1506 IF .TYP NEQ SCN_INTEGER AND .TYP NEQ SCN_STRING
; 1507 THEN
; 1508 ERROR('Type missing');
; 1509 TYP = (IF .TYP EQL SCN_INTEGER THEN STE_TYP_INT ELSE STE_TYP_STR);
; 1510 DO
; 1511 BEGIN
; 1512 IF SCAN() NEQ SCN_IDENT THEN CERROR(CERM3);
; 1513 STE = ADDSMB();
; 1514 IF .STE LSS 0 THEN CERROR(CERM4);
; 1515 SYMWRK[.STE,STE_CLS] = STE_CLS_FML;
; 1516 SYMWRK[.STE,STE_TYP] = .TYP;
; 1517 IF .PRCARG[0] GEQ MAXPRM THEN ERROR('Too many parameters');
; 1518 PRCARG[0] = .PRCARG[0] + 1;
; 1519 PRCARG[.PRCARG[0]] = .STE
; 1520 END
; 1521 WHILE
; 1522 SCAN() EQL SCN_COMMA;
; 1523 END
; 1524 WHILE
; 1525 .SCACOD EQL SCN_SEMI;
; 1526 DECR I FROM .PRCARG[0] TO 1 DO
; 1527 BEGIN
; 1528 STE = .PRCARG[.I];
; 1529 SYMWRK[.STE,STE_LOC] = - .PRCARG[0] + .I - 1;
; 1530 PRCARG[.I] = .SYMWRK[.STE,STE_TYP]
; 1531 END
; 1532 END;
P.AFF: BYTE (7)"T","y","p","e"," " ; Type
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
P.AFG: BYTE (7)"T","o","o"," ","m" ; Too m
BYTE (7)"a","n","y"," ","p" ; any p
BYTE (7)"a","r","a","m","e" ; arame
BYTE (7)"t","e","r","s",000 ; ters
CPFRML: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
L.144: PUSHJ SP,SCAN ; SP,SCAN
MOVE AC14,AC1 ; TYP,AC1
CAIE AC14,34 ; TYP,34
CAIN AC14,35 ; TYP,35
JRST L.145 ; L.145
MOVEI AC1,P.AFF ; AC1,P.AFF
PUSHJ SP,CERROR ; SP,CERROR
L.145: CAIN AC14,34 ; TYP,34
TDZA AC14,AC14 ; TYP,TYP
MOVEI AC14,1 ; TYP,1
L.146: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.147 ; L.147
MOVEI AC1,CERM3 ; AC1,CERM3
PUSHJ SP,CERROR ; SP,CERROR
L.147: PUSHJ SP,ADDSMB ; SP,ADDSMB
MOVE AC13,AC1 ; STE,AC1
JUMPGE AC13,L.148 ; STE,L.148
MOVEI AC1,CERM4 ; AC1,CERM4
PUSHJ SP,CERROR ; SP,CERROR
L.148: MOVE AC1,AC13 ; AC1,STE
IMULI AC1,2 ; AC1,2
MOVEI AC2,2 ; AC2,2
DPB AC2,C.27 ; AC2,[POINT 3,SYMWRK(AC1),5] <30,3>
DPB AC14,C.28 ; TYP,[POINT 1,SYMWRK(AC1),6] <29,1>
MOVEI AC1,10 ; AC1,10
CAMLE AC1,PRCARG ; AC1,PRCARG
JRST L.149 ; L.149
MOVEI AC1,P.AFG ; AC1,P.AFG
PUSHJ SP,CERROR ; SP,CERROR
L.149: AOS AC1,PRCARG ; AC1,PRCARG
MOVEM AC13,PRCARG(AC1) ; STE,PRCARG(AC1)
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,21 ; AC1,21
JRST L.146 ; L.146
MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.144 ; L.144
MOVE AC2,PRCARG ; I,PRCARG
AOJA AC2,L.151 ; I,L.151
L.150: MOVE AC13,PRCARG(AC2) ; STE,PRCARG(I)
MOVE AC1,AC13 ; AC1,STE
IMULI AC1,2 ; AC1,2
MOVE AC3,PRCARG ; AC3,PRCARG
SUB AC3,AC2 ; AC3,I
SETO AC4, ; AC4,
SUB AC4,AC3 ; AC4,AC3
HRRM AC4,SYMWRK(AC1) ; AC4,SYMWRK(AC1)
LDB AC3,C.28 ; AC3,[POINT 1,SYMWRK(AC1),6] <29,1>
MOVEM AC3,PRCARG(AC2) ; AC3,PRCARG(I)
L.151: SOJG AC2,L.150 ; I,L.150
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.27: POINT 3,SYMWRK(AC1),5 ; 3,SYMWRK(AC1),5
C.28: POINT 1,SYMWRK(AC1),6 ; 1,SYMWRK(AC1),6
; Routine Size: 58 words
; 1533
; 1534 ROUTINE CPCARG: NOVALUE = ! Command arguments
; 1535
; 1536 !++
; 1537 ! Functional description:
; 1538 ! Compile command arguments: Generate appropriate field descriptors
; 1539 ! in constants, containing descriptors of local symbols in which
; 1540 ! results should be stored. Declare each symbol used.
; 1541 !
; 1542 ! Formal parameters:
; 1543 ! None
; 1544 !
; 1545 ! Implicit inputs:
; 1546 ! Source
; 1547 !
; 1548 ! Implicit outputs:
; 1549 ! Constants
; 1550 !
; 1551 ! Routine value:
; 1552 ! None
; 1553 !
; 1554 ! Side effects:
; 1555 ! Scans from ( to )
; 1556 !
; 1557 !--
; 1558
; 1559 BEGIN
; 1560 EXTERNAL REGISTER Z=0;
; 1561 LOCAL
; 1562 FNC, ! Parse-type code
; 1563 FDB, ! Constant index of current FLDDB
; 1564 LFDB; ! Constant index of last FLDDB
; 1565 LFDB = -1;
; 1566 DO
; 1567 BEGIN
; 1568 SCAN();
; 1569 ! Identify the parse-type
; 1570 FDB = CPPRSI(1,0);
; 1571 IF .FDB LSS 0 THEN ERROR('OTHERWISE meaningless here');
; 1572 ! Link the new FLDDB to the preceding FLDDB
; 1573 IF .LFDB GEQ 0
; 1574 THEN
; 1575 POINTR((CNSWRK[.LFDB+$CMFNP]),CM_LST) = .FDB
; 1576 ELSE
; 1577 CMDARG = .FDB;
; 1578 LFDB = .FDB;
; 1579 END
; 1580 WHILE
; 1581 .SCACOD EQL SCN_SEMI
; 1582 END;
P.AFH: BYTE (7)"O","T","H","E","R" ; OTHER
BYTE (7)"W","I","S","E"," " ; WISE
BYTE (7)"m","e","a","n","i" ; meani
BYTE (7)"n","g","l","e","s" ; ngles
BYTE (7)"s"," ","h","e","r" ; s her
BYTE (7)"e",000,000,000,000 ; e
CPCARG: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
SETO AC14, ; LFDB,
L.152: PUSHJ SP,SCAN ; SP,SCAN
MOVEI AC1,1 ; AC1,1
SETZ AC2, ; AC2,
PUSHJ SP,CPPRSI ; SP,CPPRSI
MOVE AC13,AC1 ; FDB,AC1
JUMPGE AC13,L.153 ; FDB,L.153
MOVEI AC1,P.AFH ; AC1,P.AFH
PUSHJ SP,CERROR ; SP,CERROR
L.153: JUMPL AC14,L.154 ; LFDB,L.154
HRRM AC13,CNSWRK(AC14) ; FDB,CNSWRK(LFDB)
JRST L.155 ; L.155
L.154: MOVEM AC13,CMDARG ; FDB,CMDARG
L.155: MOVE AC14,AC13 ; LFDB,FDB
MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.152 ; L.152
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 22 words
; 1583
; 1584 ROUTINE CPBODY: NOVALUE = !<Procedure-body>
; 1585
; 1586 !++
; 1587 ! Functional description:
; 1588 ! Called from <Procedure-declaration> to compile body of routine.
; 1589 ! This may be a block or just a statement.
; 1590 !
; 1591 ! Formal parameters:
; 1592 ! None
; 1593 !
; 1594 ! Implicit inputs:
; 1595 ! Source
; 1596 !
; 1597 ! Implicit outputs:
; 1598 ! None
; 1599 !
; 1600 ! Routine value:
; 1601 ! None
; 1602 !
; 1603 ! Side effects:
; 1604 ! Scans from BEGIN to unrecognized atom
; 1605 !
; 1606 !--
; 1607
; 1608 BEGIN
; 1609 EXTERNAL REGISTER Z=0;
; 1610 IF .SCACOD NEQ SCN_BEGIN
; 1611 THEN
; 1612 BEGIN
; 1613 IF CPSTMT() EQL FALSE THEN CERROR(CERM9);
; 1614 RETURN
; 1615 END;
; 1616 SCAN();
; 1617 WHILE
; 1618 CPDECL() NEQ FALSE
; 1619 DO
; 1620 (IF .SCACOD NEQ SCN_SEMI THEN CERROR(CERM6); SCAN());
; 1621 WHILE
; 1622 .SCACOD NEQ SCN_END AND CPSTMT() NEQ FALSE
; 1623 DO
; 1624 (IF .SCACOD NEQ SCN_SEMI AND .SCACOD NEQ SCN_END
; 1625 THEN
; 1626 ERROR('No semicolon or End after last statement');
; 1627 IF .SCACOD EQL SCN_SEMI THEN SCAN());
; 1628 IF .SCACOD NEQ SCN_END THEN CERROR(CERM7);
; 1629 SCAN()
; 1630 END;
P.AFI: BYTE (7)"N","o"," ","s","e" ; No se
BYTE (7)"m","i","c","o","l" ; micol
BYTE (7)"o","n"," ","o","r" ; on or
BYTE (7)" ","E","n","d"," " ; End
BYTE (7)"a","f","t","e","r" ; after
BYTE (7)" ","l","a","s","t" ; last
BYTE (7)" ","s","t","a","t" ; stat
BYTE (7)"e","m","e","n","t" ; ement
BYTE (7)000,000,000,000,000
CPBODY: MOVEI AC1,31 ; AC1,31
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.156 ; L.156
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.161 ; AC1,L.161
MOVEI AC1,CERM9 ; AC1,CERM9
JRST CERROR ; CERROR
L.156: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPDECL ; SP,CPDECL
JUMPE AC1,L.157 ; AC1,L.157
MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.156 ; L.156
MOVEI AC1,CERM6 ; AC1,CERM6
PUSHJ SP,CERROR ; SP,CERROR
JRST L.156 ; L.156
L.157: MOVEI AC1,32 ; AC1,32
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.159 ; L.159
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPE AC1,L.159 ; AC1,L.159
MOVE AC1,SCACOD ; AC1,SCACOD
CAIE AC1,20 ; AC1,20
CAIN AC1,32 ; AC1,32
JRST L.158 ; L.158
MOVEI AC1,P.AFI ; AC1,P.AFI
PUSHJ SP,CERROR ; SP,CERROR
L.158: MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
PUSHJ SP,SCAN ; SP,SCAN
JRST L.157 ; L.157
L.159: MOVEI AC1,32 ; AC1,32
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.160 ; L.160
MOVEI AC1,CERM7 ; AC1,CERM7
PUSHJ SP,CERROR ; SP,CERROR
L.160: PUSHJ SP,SCAN ; SP,SCAN
L.161: POPJ SP, ; SP,
; Routine Size: 38 words
; 1631
; 1632 ROUTINE CPDECL = ! <Declaration>
; 1633
; 1634 !++
; 1635 ! Functional description:
; 1636 ! Called from <Procedure-body> to process one declaration.
; 1637 !
; 1638 ! Formal parameters:
; 1639 ! None
; 1640 !
; 1641 ! Implicit inputs:
; 1642 ! Source
; 1643 !
; 1644 ! Implicit outputs:
; 1645 ! Symbol table
; 1646 !
; 1647 ! Routine value:
; 1648 ! TRUE if declaration recognized, FALSE if not
; 1649 !
; 1650 ! Side effects:
; 1651 ! Scans from <Simple-type> past last <Identifier>
; 1652 !
; 1653 !--
; 1654
; 1655 BEGIN
; 1656 EXTERNAL REGISTER Z=0;
; 1657 LOCAL
; 1658 STE, ! Symbol table index
; 1659 CLS, ! Variable class
; 1660 TYP; ! Variable type
; 1661 IF .SCACOD NEQ SCN_EXTERNAL AND .SCACOD NEQ SCN_INTEGER
; 1662 AND .SCACOD NEQ SCN_STRING THEN RETURN FALSE;
; 1663 CLS = STE_CLS_VAR;
; 1664 IF .SCACOD EQL SCN_EXTERNAL THEN (CLS = STE_CLS_GBL; SCAN());
; 1665 IF .SCACOD EQL SCN_INTEGER OR .SCACOD EQL SCN_STRING
; 1666 THEN
; 1667 BEGIN
; 1668 TYP = (IF .SCACOD EQL SCN_INTEGER THEN STE_TYP_INT ELSE STE_TYP_STR);
; 1669 IF SCAN() EQL SCN_PROCEDURE
; 1670 THEN
; 1671 BEGIN
; 1672 CLS = STE_CLS_FCN;
; 1673 SCAN()
; 1674 END
; 1675 END
; 1676 ELSE
; 1677 IF .SCACOD EQL SCN_PROCEDURE
; 1678 THEN
; 1679 BEGIN
; 1680 CLS = STE_CLS_PRC;
; 1681 SCAN()
; 1682 END
; 1683 ELSE
; 1684 ERROR('Type not found where required');
; 1685 IF .SCACOD NEQ SCN_IDENT THEN CERROR(CERM3);
; 1686 WHILE
; 1687 .SCACOD EQL SCN_IDENT
; 1688 DO
; 1689 BEGIN
; 1690 STE = ADDSMB();
; 1691 IF .STE LSS 0 THEN CERROR(CERM4);
; 1692 IF .NUMVRS GEQ MAXVRC THEN CERROR(CERM15);
; 1693 SYMWRK[.STE,STE_CLS] = .CLS;
; 1694 SYMWRK[.STE,STE_TYP] = .TYP;
; 1695 IF .CLS EQL STE_CLS_VAR
; 1696 THEN
; 1697 BEGIN
; 1698 SYMWRK[.STE,STE_LOC] = .NUMVRS + FRM_LOC;
; 1699 NUMVRS = .NUMVRS + 1
; 1700 END;
; 1701 IF SCAN() NEQ SCN_COMMA THEN EXITLOOP;
; 1702 SCAN()
; 1703 END;
; 1704 TRUE
; 1705 END;
P.AFJ: BYTE (7)"T","y","p","e"," " ; Type
BYTE (7)"n","o","t"," ","f" ; not f
BYTE (7)"o","u","n","d"," " ; ound
BYTE (7)"w","h","e","r","e" ; where
BYTE (7)" ","r","e","q","u" ; requ
BYTE (7)"i","r","e","d",000 ; ired
CPDECL: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC1,SCACOD ; AC1,SCACOD
CAIE AC1,33 ; AC1,33
CAIN AC1,34 ; AC1,34
JRST L.162 ; L.162
CAIN AC1,35 ; AC1,35
JRST L.162 ; L.162
SETZ AC1, ; AC1,
JRST L.175 ; L.175
L.162: SETZ AC14, ; CLS,
CAIE AC1,33 ; AC1,33
JRST L.163 ; L.163
MOVEI AC14,1 ; CLS,1
PUSHJ SP,SCAN ; SP,SCAN
L.163: MOVE AC1,SCACOD ; AC1,SCACOD
SETZ AC2, ; AC2,
CAIE AC1,34 ; AC1,34
JRST L.164 ; L.164
MOVEI AC2,1 ; AC2,1
JRST L.165 ; L.165
L.164: CAIE AC1,35 ; AC1,35
JRST L.166 ; L.166
L.165: TRNE AC2,1 ; AC2,1
TDZA AC12,AC12 ; TYP,TYP
MOVEI AC12,1 ; TYP,1
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,25 ; AC1,25
JRST L.169 ; L.169
MOVEI AC14,4 ; CLS,4
JRST L.167 ; L.167
L.166: CAIE AC1,25 ; AC1,25
JRST L.168 ; L.168
MOVEI AC14,3 ; CLS,3
L.167: PUSHJ SP,SCAN ; SP,SCAN
JRST L.169 ; L.169
L.168: MOVEI AC1,P.AFJ ; AC1,P.AFJ
PUSHJ SP,CERROR ; SP,CERROR
L.169: MOVEI AC1,1 ; AC1,1
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.170 ; L.170
MOVEI AC1,CERM3 ; AC1,CERM3
PUSHJ SP,CERROR ; SP,CERROR
L.170: MOVEI AC1,1 ; AC1,1
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.174 ; L.174
PUSHJ SP,ADDSMB ; SP,ADDSMB
MOVE AC13,AC1 ; STE,AC1
JUMPGE AC13,L.171 ; STE,L.171
MOVEI AC1,CERM4 ; AC1,CERM4
PUSHJ SP,CERROR ; SP,CERROR
L.171: MOVEI AC1,200 ; AC1,200
CAMLE AC1,NUMVRS ; AC1,NUMVRS
JRST L.172 ; L.172
MOVEI AC1,CERM15 ; AC1,CERM15
PUSHJ SP,CERROR ; SP,CERROR
L.172: MOVE AC1,AC13 ; AC1,STE
IMULI AC1,2 ; AC1,2
DPB AC14,C.27 ; CLS,[POINT 3,SYMWRK(AC1),5] <30,3>
DPB AC12,C.28 ; TYP,[POINT 1,SYMWRK(AC1),6] <29,1>
JUMPN AC14,L.173 ; CLS,L.173
MOVE AC2,NUMVRS ; AC2,NUMVRS
ADDI AC2,2 ; AC2,2
HRRM AC2,SYMWRK(AC1) ; AC2,SYMWRK(AC1)
AOS NUMVRS ; NUMVRS
L.173: PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,21 ; AC1,21
JRST L.174 ; L.174
PUSHJ SP,SCAN ; SP,SCAN
JRST L.170 ; L.170
L.174: SETO AC1, ; AC1,
L.175: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 76 words
; 1706
; 1707 ROUTINE CPSTMT = ! <Statement>
; 1708
; 1709 !++
; 1710 ! Functional description:
; 1711 ! Called to process one statement.
; 1712 !
; 1713 ! Formal parameters:
; 1714 ! None
; 1715 !
; 1716 ! Implicit inputs:
; 1717 ! Source
; 1718 !
; 1719 ! Implicit outputs:
; 1720 ! Code, Label table
; 1721 !
; 1722 ! Routine value:
; 1723 ! TRUE if statement recognized, FALSE if not
; 1724 !
; 1725 ! Side effects:
; 1726 ! Scans from potential statement keyword (or label) to unrecognized atom
; 1727 !
; 1728 !--
; 1729
; 1730 BEGIN
; 1731 EXTERNAL REGISTER Z=0;
; 1732 WHILE
; 1733 .SCACOD EQL SCN_IDENT OR .SCACOD EQL SCN_SYSNAME
; 1734 DO
; 1735 BEGIN
; 1736 LOCAL
; 1737 IDNLLN, ! Pointer to line with bad identifier
; 1738 IDNPTR, ! Pointer to bad identifier
; 1739 IDNCOD; ! Scan code of identifier
; 1740 IDNLLN = .LLNPTR;
; 1741 IDNPTR = .SCAPTR;
; 1742 IDNCOD = .SCACOD;
; 1743 SCAN();
; 1744 IF .IDNCOD EQL SCN_IDENT AND .SCACOD EQL SCN_COLON
; 1745 THEN
; 1746 BEGIN
; 1747 DEFLBL();
; 1748 SCAN()
; 1749 END
; 1750 ELSE
; 1751 IF .SCACOD EQL SCN_EQL
; 1752 THEN
; 1753 BEGIN
; 1754 CPASGN(.IDNCOD);
; 1755 RETURN TRUE
; 1756 END
; 1757 ELSE
; 1758 BEGIN
; 1759 LLNPTR = .IDNLLN;
; 1760 SCAPTR = .IDNPTR;
; 1761 CERROR(CERM5);
; 1762 END
; 1763 END;
; 1764 SELECTONE .SCACOD OF
; 1765 SET
; 1766 [SCN_BEGIN]: BEGIN
; 1767 SCAN();
; 1768 WHILE
; 1769 .SCACOD NEQ SCN_END AND CPSTMT() NEQ FALSE
; 1770 DO
; 1771 BEGIN
; 1772 IF .SCACOD NEQ SCN_SEMI AND .SCACOD NEQ SCN_END
; 1773 THEN
; 1774 CERROR(CERM6);
; 1775 IF .SCACOD EQL SCN_SEMI THEN SCAN()
; 1776 END;
; 1777 IF .SCACOD NEQ SCN_END
; 1778 THEN
; 1779 CERROR(CERM7);
; 1780 SCAN()
; 1781 END;
; 1782 [SCN_LET]: CPASGN(-1);
; 1783 [SCN_IF]: CPCNDI();
; 1784 [SCN_GOTO]: CPGOTO();
; 1785 [SCN_RETURN]: CPRETN();
; 1786 [SCN_CASE]: CPCASE();
; 1787 [SCN_DO,
; 1788 SCN_WHILE,
; 1789 SCN_UNTIL]: CPLOOP();
; 1790 [SCN_SELECT]: CPSELE();
; 1791 [SCN_DOCOMMAND]:CPPFRM();
; 1792 [SCN_GUIDE]: CPGUID();
; 1793 [SCN_PARSE]: CPPRSE();
; 1794 [SCN_PROMPT]: CPPMPT();
; 1795 [SCN_INVOKE]: CPINVK();
; 1796 [SCN_TYPEIN]: CPTYIN();
; 1797 [SCN_GETTYPEOUT]:CPCOMS(OPR_GTO,1);
; 1798 [SCN_CLEARTYPEOUT]: (GENINS(OPR_GTO,-1,0,0); SCAN());
; 1799 [SCN_KILLPROGRAM]: (GENINS(OPR_KIL,0,0,0); SCAN());
; 1800 [SCN_DISPLAY]: CPDPLY();
; 1801 [SCN_EXIT]: CPEXIT();
; 1802 [SCN_ABORT]: CPCOMS(OPR_ABT,0);
; 1803 [SCN_NOP]: (GENINS(OPR_NOP,0,0,0); SCAN());
; 1804 [SCN_CALL]: CPCALL();
; 1805 [SCN_END]: RETURN FALSE;
; 1806 [SCN_EOFILE]: CERROR(CERM17);
; 1807 [SCN_INTEGER,
; 1808 SCN_STRING,
; 1809 SCN_EXTERNAL]: ERROR('Declarations not permitted after first statement');
; 1810 [OTHERWISE]: CERROR(CERM5)
; 1811 TES;
; 1812 TRUE
; 1813 END;
P.AFK: BYTE (7)"D","e","c","l","a" ; Decla
BYTE (7)"r","a","t","i","o" ; ratio
BYTE (7)"n","s"," ","n","o" ; ns no
BYTE (7)"t"," ","p","e","r" ; t per
BYTE (7)"m","i","t","t","e" ; mitte
BYTE (7)"d"," ","a","f","t" ; d aft
BYTE (7)"e","r"," ","f","i" ; er fi
BYTE (7)"r","s","t"," ","s" ; rst s
BYTE (7)"t","a","t","e","m" ; tatem
BYTE (7)"e","n","t",000,000 ; ent
CPSTMT: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
L.176: MOVE AC1,SCACOD ; AC1,SCACOD
CAIN AC1,1 ; AC1,1
JRST L.177 ; L.177
CAIE AC1,112 ; AC1,112
JRST L.180 ; L.180
L.177: MOVE AC14,LLNPTR ; IDNLLN,LLNPTR
MOVE AC13,SCAPTR ; IDNPTR,SCAPTR
MOVE AC12,AC1 ; IDNCOD,AC1
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC12,1 ; IDNCOD,1
JRST L.178 ; L.178
MOVEI AC1,22 ; AC1,22
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.178 ; L.178
PUSHJ SP,DEFLBL ; SP,DEFLBL
PUSHJ SP,SCAN ; SP,SCAN
JRST L.176 ; L.176
L.178: MOVEI AC1,13 ; AC1,13
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.179 ; L.179
MOVE AC1,AC12 ; AC1,IDNCOD
JRST L.186 ; L.186
L.179: MOVEM AC14,LLNPTR ; IDNLLN,LLNPTR
MOVEM AC13,SCAPTR ; IDNPTR,SCAPTR
MOVEI AC1,CERM5 ; AC1,CERM5
PUSHJ SP,CERROR ; SP,CERROR
JRST L.176 ; L.176
L.180: MOVE AC14,SCACOD ; AC14,SCACOD
CAIE AC14,31 ; AC14,31
JRST L.185 ; L.185
L.181: PUSHJ SP,SCAN ; SP,SCAN
L.182: MOVEI AC1,32 ; AC1,32
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.184 ; L.184
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPE AC1,L.184 ; AC1,L.184
MOVE AC1,SCACOD ; AC1,SCACOD
CAIE AC1,20 ; AC1,20
CAIN AC1,32 ; AC1,32
JRST L.183 ; L.183
MOVEI AC1,CERM6 ; AC1,CERM6
PUSHJ SP,CERROR ; SP,CERROR
L.183: MOVEI AC1,20 ; AC1,20
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.182 ; L.182
JRST L.181 ; L.181
L.184: MOVEI AC1,32 ; AC1,32
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.209 ; L.209
MOVEI AC1,CERM7 ; AC1,CERM7
PUSHJ SP,CERROR ; SP,CERROR
JRST L.209 ; L.209
L.185: CAIE AC14,36 ; AC14,36
JRST L.187 ; L.187
SETO AC1, ; AC1,
L.186: PUSHJ SP,CPASGN ; SP,CPASGN
JRST L.216 ; L.216
L.187: CAIE AC14,37 ; AC14,37
JRST L.188 ; L.188
PUSHJ SP,CPCNDI ; SP,CPCNDI
JRST L.216 ; L.216
L.188: CAIE AC14,42 ; AC14,42
JRST L.189 ; L.189
PUSHJ SP,CPGOTO ; SP,CPGOTO
JRST L.216 ; L.216
L.189: CAIE AC14,43 ; AC14,43
JRST L.190 ; L.190
PUSHJ SP,CPRETN ; SP,CPRETN
JRST L.216 ; L.216
L.190: CAIE AC14,44 ; AC14,44
JRST L.191 ; L.191
PUSHJ SP,CPCASE ; SP,CPCASE
JRST L.216 ; L.216
L.191: CAIL AC14,52 ; AC14,52
CAILE AC14,54 ; AC14,54
JRST L.192 ; L.192
PUSHJ SP,CPLOOP ; SP,CPLOOP
JRST L.216 ; L.216
L.192: CAIE AC14,55 ; AC14,55
JRST L.193 ; L.193
PUSHJ SP,CPSELE ; SP,CPSELE
JRST L.216 ; L.216
L.193: CAIE AC14,56 ; AC14,56
JRST L.194 ; L.194
PUSHJ SP,CPPFRM ; SP,CPPFRM
JRST L.216 ; L.216
L.194: CAIE AC14,60 ; AC14,60
JRST L.195 ; L.195
PUSHJ SP,CPGUID ; SP,CPGUID
JRST L.216 ; L.216
L.195: CAIE AC14,61 ; AC14,61
JRST L.196 ; L.196
PUSHJ SP,CPPRSE ; SP,CPPRSE
JRST L.216 ; L.216
L.196: CAIE AC14,110 ; AC14,110
JRST L.197 ; L.197
PUSHJ SP,CPPMPT ; SP,CPPMPT
JRST L.216 ; L.216
L.197: CAIE AC14,113 ; AC14,113
JRST L.198 ; L.198
PUSHJ SP,CPINVK ; SP,CPINVK
JRST L.216 ; L.216
L.198: CAIE AC14,115 ; AC14,115
JRST L.199 ; L.199
PUSHJ SP,CPTYIN ; SP,CPTYIN
JRST L.216 ; L.216
L.199: CAIE AC14,117 ; AC14,117
JRST L.200 ; L.200
MOVEI AC1,35 ; AC1,35
MOVEI AC2,1 ; AC2,1
JRST L.205 ; L.205
L.200: CAIE AC14,120 ; AC14,120
JRST L.201 ; L.201
MOVEI AC1,35 ; AC1,35
SETO AC2, ; AC2,
JRST L.208 ; L.208
L.201: CAIE AC14,121 ; AC14,121
JRST L.202 ; L.202
MOVEI AC1,36 ; AC1,36
JRST L.207 ; L.207
L.202: CAIE AC14,122 ; AC14,122
JRST L.203 ; L.203
PUSHJ SP,CPDPLY ; SP,CPDPLY
JRST L.216 ; L.216
L.203: CAIE AC14,124 ; AC14,124
JRST L.204 ; L.204
PUSHJ SP,CPEXIT ; SP,CPEXIT
JRST L.216 ; L.216
L.204: CAIE AC14,127 ; AC14,127
JRST L.206 ; L.206
MOVEI AC1,43 ; AC1,43
SETZ AC2, ; AC2,
L.205: PUSHJ SP,CPCOMS ; SP,CPCOMS
JRST L.216 ; L.216
L.206: CAIE AC14,130 ; AC14,130
JRST L.210 ; L.210
MOVEI AC1,44 ; AC1,44
L.207: SETZ AC2, ; AC2,
L.208: SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
L.209: PUSHJ SP,SCAN ; SP,SCAN
JRST L.216 ; L.216
L.210: CAIE AC14,131 ; AC14,131
JRST L.211 ; L.211
PUSHJ SP,CPCALL ; SP,CPCALL
JRST L.216 ; L.216
L.211: CAIE AC14,32 ; AC14,32
JRST L.212 ; L.212
SETZ AC1, ; AC1,
JRST L.217 ; L.217
L.212: CAIE AC14,132 ; AC14,132
JRST L.213 ; L.213
MOVEI AC1,CERM17 ; AC1,CERM17
JRST L.215 ; L.215
L.213: CAIL AC14,33 ; AC14,33
CAILE AC14,35 ; AC14,35
JRST L.214 ; L.214
MOVEI AC1,P.AFK ; AC1,P.AFK
JRST L.215 ; L.215
L.214: MOVEI AC1,CERM5 ; AC1,CERM5
L.215: PUSHJ SP,CERROR ; SP,CERROR
L.216: SETO AC1, ; AC1,
L.217: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 169 words
; 1814
; 1815 ROUTINE CPASGN(SCN): NOVALUE = ! <Assignment-statement>
; 1816
; 1817 !++
; 1818 ! Functional description:
; 1819 ! Called from <Statement> to process an assignment statement.
; 1820 !
; 1821 ! Formal parameters:
; 1822 ! Scan code of destination if already scanned and ready in SCATOM,
; 1823 ! -1 if it is yet to be scanned. If the scan code is provided,
; 1824 ! then the equals sign is the current atom.
; 1825 !
; 1826 ! Implicit inputs:
; 1827 ! Source, symbol table
; 1828 !
; 1829 ! Implicit outputs:
; 1830 ! Code
; 1831 !
; 1832 ! Routine value:
; 1833 ! None
; 1834 !
; 1835 ! Side effects:
; 1836 ! Scans from LET or destination identifier to unrecognized atom
; 1837 !
; 1838 !--
; 1839
; 1840 BEGIN
; 1841 EXTERNAL REGISTER Z=0;
; 1842 LOCAL
; 1843 DSTN, ! Destination designator
; 1844 TYPE; ! Data type
; 1845 IF .SCN LSS 0 THEN SCAN() ELSE SCACOD = .SCN;
; 1846 IF .SCACOD EQL SCN_IDENT
; 1847 THEN
; 1848 BEGIN
; 1849 DSTN = FNDSMB(-1,-1);
; 1850 IF .DSTN LSS 0 THEN ERROR('Undefined variable');
; 1851 IF .SYMWRK[.DSTN,STE_CLS] EQL STE_CLS_PRC
; 1852 OR .SYMWRK[.DSTN,STE_CLS] EQL STE_CLS_FCN
; 1853 THEN
; 1854 ERROR('Cannot store into a procedure');
; 1855 TYPE = .SYMWRK[.DSTN,STE_TYP]
; 1856 END
; 1857 ELSE
; 1858 IF .SCACOD EQL SCN_SYSNAME
; 1859 THEN
; 1860 BEGIN
; 1861 MAP DSTN: OPRAND;
; 1862 IF .PSDEFN[.SCATOM,SYN_CLS] NEQ SYN_CLS_VAR
; 1863 THEN
; 1864 ERROR('Cannot store into routine');
; 1865 IF NOT .PSDEFN[.SCATOM,SYN_WRT] THEN ERROR('Variable is readonly');
; 1866 DSTN[OPN_ADR] = .SCATOM;
; 1867 DSTN[OPN_CLS] = OPN_CLS_SYN;
; 1868 TYPE = .PSDEFN[.SCATOM,SYN_TYP]
; 1869 END
; 1870 ELSE
; 1871 CERROR(CERM8);
; 1872 IF .SCN LSS 0 THEN IF SCAN() NEQ SCN_EQL THEN ERROR('Equal sign missing');
; 1873 SCAN();
; 1874 CASE .TYPE FROM STE_TYP_INT TO STE_TYP_STR OF
; 1875 SET
; 1876 [STE_TYP_INT]: CPIEXP(.DSTN);
; 1877 [STE_TYP_STR]: CPSEXP(.DSTN);
; 1878 TES
; 1879 END;
P.AFL: BYTE (7)"U","n","d","e","f" ; Undef
BYTE (7)"i","n","e","d"," " ; ined
BYTE (7)"v","a","r","i","a" ; varia
BYTE (7)"b","l","e",000,000 ; ble
P.AFM: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","s","t","o" ; t sto
BYTE (7)"r","e"," ","i","n" ; re in
BYTE (7)"t","o"," ","a"," " ; to a
BYTE (7)"p","r","o","c","e" ; proce
BYTE (7)"d","u","r","e",000 ; dure
P.AFN: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","s","t","o" ; t sto
BYTE (7)"r","e"," ","i","n" ; re in
BYTE (7)"t","o"," ","r","o" ; to ro
BYTE (7)"u","t","i","n","e" ; utine
BYTE (7)000,000,000,000,000
P.AFO: BYTE (7)"V","a","r","i","a" ; Varia
BYTE (7)"b","l","e"," ","i" ; ble i
BYTE (7)"s"," ","r","e","a" ; s rea
BYTE (7)"d","o","n","l","y" ; donly
BYTE (7)000,000,000,000,000
P.AFP: BYTE (7)"E","q","u","a","l" ; Equal
BYTE (7)" ","s","i","g","n" ; sign
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
CPASGN: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
SETZ AC12, ; AC12,
JUMPGE AC1,L.218 ; SCN,L.218
MOVEI AC12,1 ; AC12,1
PUSHJ SP,SCAN ; SP,SCAN
JRST L.219 ; L.219
L.218: MOVEM AC1,SCACOD ; SCN,SCACOD
L.219: MOVE AC1,SCACOD ; AC1,SCACOD
CAIE AC1,1 ; AC1,1
JRST L.223 ; L.223
SETOB AC1,AC2 ; AC1,AC2
PUSHJ SP,FNDSMB ; SP,FNDSMB
MOVE AC13,AC1 ; DSTN,AC1
JUMPGE AC13,L.220 ; DSTN,L.220
MOVEI AC1,P.AFL ; AC1,P.AFL
PUSHJ SP,CERROR ; SP,CERROR
L.220: MOVE AC14,AC13 ; AC14,DSTN
IMULI AC14,2 ; AC14,2
LDB AC1,C.29 ; AC1,[POINT 3,SYMWRK(AC14),5] <30,3>
CAIN AC1,3 ; AC1,3
JRST L.221 ; L.221
CAIE AC1,4 ; AC1,4
JRST L.222 ; L.222
L.221: MOVEI AC1,P.AFM ; AC1,P.AFM
PUSHJ SP,CERROR ; SP,CERROR
L.222: LDB AC14,C.30 ; TYPE,[POINT 1,SYMWRK(AC14),6] <29,1>
JRST L.227 ; L.227
L.223: CAIE AC1,112 ; AC1,112
JRST L.226 ; L.226
MOVE AC1,SCATOM ; AC1,SCATOM
IMULI AC1,2 ; AC1,2
LDB AC2,C.31 ; AC2,[POINT 3,PSDEFN(AC1),17] <18,3>
CAIN AC2,2 ; AC2,2
JRST L.224 ; L.224
MOVEI AC1,P.AFN ; AC1,P.AFN
PUSHJ SP,CERROR ; SP,CERROR
L.224: MOVE AC1,SCATOM ; AC1,SCATOM
IMULI AC1,2 ; AC1,2
MOVSI AC2,200000 ; AC2,200000
TDNE AC2,PSDEFN(AC1) ; AC2,PSDEFN(AC1)
JRST L.225 ; L.225
MOVEI AC1,P.AFO ; AC1,P.AFO
PUSHJ SP,CERROR ; SP,CERROR
L.225: MOVE AC1,SCATOM ; AC1,SCATOM
DPB AC1,C.32 ; AC1,[POINT 15,DSTN,35] <0,15>
TRZ AC13,-200000 ; DSTN,-200000
TRO AC13,200000 ; DSTN,200000
MOVE AC1,SCATOM ; AC1,SCATOM
IMULI AC1,2 ; AC1,2
LDB AC14,C.33 ; TYPE,[POINT 3,PSDEFN(AC1),14] <21,3>
JRST L.227 ; L.227
L.226: MOVEI AC1,CERM8 ; AC1,CERM8
PUSHJ SP,CERROR ; SP,CERROR
L.227: TRNN AC12,1 ; AC12,1
JRST L.228 ; L.228
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,13 ; AC1,13
JRST L.228 ; L.228
MOVEI AC1,P.AFP ; AC1,P.AFP
PUSHJ SP,CERROR ; SP,CERROR
L.228: PUSHJ SP,SCAN ; SP,SCAN
JRST L.229(AC14) ; L.229(TYPE)
L.229: JRST L.230 ; L.230
JRST L.231 ; L.231
L.230: MOVE AC1,AC13 ; AC1,DSTN
PUSHJ SP,CPIEXP ; SP,CPIEXP
JRST L.232 ; L.232
L.231: MOVE AC1,AC13 ; AC1,DSTN
PUSHJ SP,CPSEXP ; SP,CPSEXP
L.232: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.29: POINT 3,SYMWRK(AC14),5 ; 3,SYMWRK(AC14),5
C.30: POINT 1,SYMWRK(AC14),6 ; 1,SYMWRK(AC14),6
C.31: POINT 3,PSDEFN(AC1),17 ; 3,PSDEFN(AC1),17
C.32: POINT 15,AC13,35 ; 15,DSTN,35
C.33: POINT 3,PSDEFN(AC1),14 ; 3,PSDEFN(AC1),14
; Routine Size: 80 words
; 1880
; 1881 ROUTINE CPCNDI: NOVALUE = ! <Conditional-statement>
; 1882
; 1883 !++
; 1884 ! Functional description:
; 1885 ! Called from <Statement> to process a conditional statement.
; 1886 !
; 1887 ! Formal parameters:
; 1888 ! None
; 1889 !
; 1890 ! Implicit inputs:
; 1891 ! Source
; 1892 !
; 1893 ! Implicit outputs:
; 1894 ! Code
; 1895 !
; 1896 ! Routine value:
; 1897 ! None
; 1898 !
; 1899 ! Side effects:
; 1900 ! Scans from IF to unrecognized atom
; 1901 !
; 1902 !--
; 1903
; 1904 BEGIN
; 1905 EXTERNAL REGISTER Z=0;
; 1906 LOCAL
; 1907 CNDADR, ! Location of Compare instruction
; 1908 JMPADR; ! Location if Jump instruction before Else
; 1909 SCAN();
; 1910 CNDADR = CPIFST(); ! Emit Compare and true-statement
; 1911 IF .SCACOD EQL SCN_ELSE
; 1912 THEN
; 1913 BEGIN
; 1914 JMPADR = .NEXTIN;
; 1915 GENINS(OPR_JMP,0,0,0);
; 1916 CODWRK[.CNDADR,COD_OPA] = .NEXTIN;
; 1917 SCAN();
; 1918 IF CPSTMT() EQL FALSE THEN CERROR(CERM9);
; 1919 CODWRK[.JMPADR,COD_OPA] = .NEXTIN
; 1920 END
; 1921 END;
CPCNDI: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPIFST ; SP,CPIFST
MOVE AC14,AC1 ; CNDADR,AC1
MOVEI AC1,41 ; AC1,41
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.234 ; L.234
MOVE AC13,NEXTIN ; JMPADR,NEXTIN
MOVEI AC1,30 ; AC1,30
SETZB AC2,AC3 ; AC2,AC3
SETZ AC4, ; AC4,
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC14) ; AC1,CODWRK(CNDADR)
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.233 ; AC1,L.233
MOVEI AC1,CERM9 ; AC1,CERM9
PUSHJ SP,CERROR ; SP,CERROR
L.233: MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC13) ; AC1,CODWRK(JMPADR)
L.234: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 25 words
; 1922
; 1923 ROUTINE CPIFST = ! <If-statement>
; 1924
; 1925 !++
; 1926 ! Functional description:
; 1927 ! Called from <Conditional-statement> to compile a simple IF
; 1928 ! statement, generating the appropriate Compare instruction
; 1929 ! and the true-statement, with the Compare branch address
; 1930 ! adjusted after the true-statement.
; 1931 !
; 1932 ! Formal parameters:
; 1933 ! None
; 1934 !
; 1935 ! Implicit inputs:
; 1936 ! Source
; 1937 !
; 1938 ! Implicit outputs:
; 1939 ! Code
; 1940 !
; 1941 ! Routine value:
; 1942 ! Code index of Compare instruction
; 1943 !
; 1944 ! Side effects:
; 1945 ! Scans from first atom of logical expression past last atom
; 1946 ! of true-expression
; 1947 !
; 1948 !--
; 1949
; 1950 BEGIN
; 1951 EXTERNAL REGISTER Z=0;
; 1952 LOCAL
; 1953 IFADDR; ! Location of Compare instruction
; 1954 IFADDR = CPLEXP();
; 1955 IF .SCACOD NEQ SCN_THEN THEN ERROR('THEN missing');
; 1956 SCAN();
; 1957 IF CPSTMT() EQL FALSE THEN CERROR(CERM9);
; 1958 CODWRK[.IFADDR,COD_OPA] = .NEXTIN;
; 1959 .IFADDR
; 1960 END;
P.AFQ: BYTE (7)"T","H","E","N"," " ; THEN
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
CPIFST: PUSH SP,AC14 ; SP,AC14
PUSHJ SP,CPLEXP ; SP,CPLEXP
MOVE AC14,AC1 ; IFADDR,AC1
MOVEI AC1,40 ; AC1,40
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.235 ; L.235
MOVEI AC1,P.AFQ ; AC1,P.AFQ
PUSHJ SP,CERROR ; SP,CERROR
L.235: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.236 ; AC1,L.236
MOVEI AC1,CERM9 ; AC1,CERM9
PUSHJ SP,CERROR ; SP,CERROR
L.236: MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC14) ; AC1,CODWRK(IFADDR)
MOVE AC1,AC14 ; AC1,IFADDR
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 18 words
; 1961
; 1962 ROUTINE CPGOTO: NOVALUE = ! <Goto-statement>
; 1963
; 1964 !++
; 1965 ! Functional description:
; 1966 ! Called from <Statement> to process a Goto statement.
; 1967 ! Generates a Jump to the labelled location; if the label is not yet
; 1968 ! defined, the Jump address is placed in the labels table.
; 1969 !
; 1970 ! Formal parameters:
; 1971 ! None
; 1972 !
; 1973 ! Implicit inputs:
; 1974 ! Code, label table
; 1975 !
; 1976 ! Implicit outputs:
; 1977 ! Code, label table
; 1978 !
; 1979 ! Routine value:
; 1980 ! None
; 1981 !
; 1982 ! Side effects:
; 1983 ! Scans from GOTO to unrecognized atom
; 1984 !
; 1985 !--
; 1986
; 1987 BEGIN
; 1988 EXTERNAL REGISTER Z=0;
; 1989 LOCAL PTR;
; 1990 IF SCAN() NEQ SCN_IDENT THEN CERROR(CERM3);
; 1991 PTR =
; 1992 (DECR I FROM .LBLCNT-1 DO
; 1993 IF CH$EQL(.SCALEN+1, BYTPTR(SCATOM), .SCALEN+1, .LBLNAM[.I])
; 1994 THEN
; 1995 EXITLOOP .I);
; 1996 IF .PTR LSS 0
; 1997 THEN
; 1998 BEGIN
; 1999 IF .LBLCNT GEQ MAXLBL THEN CERROR(CERM10);
; 2000 LBLNAM[.LBLCNT] = BYTPTR(PCMGMM((.SCALEN+5)/5, DICT));
; 2001 CH$MOVE(.SCALEN+1, BYTPTR(SCATOM), .LBLNAM[.LBLCNT]);
; 2002 LBLADR[.LBLCNT] = -.NEXTIN;
; 2003 LBLCNT = .LBLCNT + 1;
; 2004 PTR = 0
; 2005 END
; 2006 ELSE
; 2007 IF .LBLADR[.PTR] LSS 0
; 2008 THEN
; 2009 BEGIN
; 2010 LOCAL
; 2011 EPTR;
; 2012 EPTR = - .LBLADR[.PTR];
; 2013 LBLADR[.PTR] = - .NEXTIN;
; 2014 PTR = .EPTR
; 2015 END
; 2016 ELSE
; 2017 PTR = .LBLADR[.PTR];
; 2018 GENINS(OPR_JMP,.PTR,0,0);
; 2019 SCAN()
; 2020 END;
CPGOTO: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.237 ; L.237
MOVEI AC1,CERM3 ; AC1,CERM3
PUSHJ SP,CERROR ; SP,CERROR
L.237: MOVE AC13,LBLCNT ; AC13,LBLCNT
MOVE AC3,SCALEN ; AC3,SCALEN
ADDI AC3,1 ; AC3,1
MOVE AC14,AC13 ; I,AC13
JRST L.239 ; L.239
L.238: MOVE AC2,C.3 ; HLF,[SCATOM]
HRLI AC2,-337100 ; HLF,-337100
MOVE AC1,AC3 ; AC1,AC3
MOVE AC4,AC3 ; AC4,AC3
MOVE AC5,LBLNAM(AC14) ; AC5,LBLNAM(I)
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.239 ; L.239
JRST L.240 ; L.240
L.239: SOJGE AC14,L.238 ; I,L.238
SETO AC14, ; PTR,
L.240: JUMPGE AC14,L.242 ; PTR,L.242
CAIGE AC13,24 ; AC13,24
JRST L.241 ; L.241
MOVEI AC1,CERM10 ; AC1,CERM10
PUSHJ SP,CERROR ; SP,CERROR
L.241: MOVE AC13,LBLCNT ; AC13,LBLCNT
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,DICT ; AC2,DICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
HRLI AC1,-337100 ; HLF,-337100
MOVEM AC1,LBLNAM(AC13) ; HLF,LBLNAM(AC13)
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,1 ; AC1,1
MOVE AC2,C.3 ; HLF,[SCATOM]
HRLI AC2,-337100 ; HLF,-337100
MOVE AC3,LBLCNT ; AC3,LBLCNT
MOVE AC4,AC1 ; AC4,AC1
MOVE AC5,LBLNAM(AC3) ; AC5,LBLNAM(AC3)
EXTEND AC1,C.12 ; AC1,[MOVSLJ ]
JFCL ;
MOVE AC1,NEXTIN ; AC1,NEXTIN
MOVNM AC1,LBLADR(AC3) ; AC1,LBLADR(AC3)
AOS LBLCNT ; LBLCNT
SETZ AC14, ; PTR,
JRST L.244 ; L.244
L.242: MOVE AC1,LBLADR(AC14) ; AC1,LBLADR(PTR)
JUMPGE AC1,L.243 ; AC1,L.243
MOVN AC1,AC1 ; EPTR,AC1
MOVE AC2,NEXTIN ; AC2,NEXTIN
MOVNM AC2,LBLADR(AC14) ; AC2,LBLADR(PTR)
L.243: MOVE AC14,AC1 ; PTR,AC1
L.244: MOVEI AC1,30 ; AC1,30
MOVE AC2,AC14 ; AC2,PTR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
PUSHJ SP,SCAN ; SP,SCAN
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 63 words
; 2021
; 2022 ROUTINE CPCASE: NOVALUE = ! <Case-statement>
; 2023
; 2024 !++
; 2025 ! Functional description:
; 2026 ! Called from <Statement> to compile a Case statement.
; 2027 !
; 2028 ! Formal parameters:
; 2029 ! None
; 2030 !
; 2031 ! Implicit inputs:
; 2032 ! Source atoms
; 2033 !
; 2034 ! Implicit outputs:
; 2035 ! Code, constants
; 2036 !
; 2037 ! Routine value:
; 2038 ! None
; 2039 !
; 2040 ! Side effects:
; 2041 ! Scans from CASE to unrecognized atom
; 2042 !
; 2043 !--
; 2044
; 2045 BEGIN
; 2046 EXTERNAL REGISTER Z=0;
; 2047 LOCAL
; 2048 OPN, ! Operand descriptor
; 2049 IDX, ! Case index
; 2050 LOC, ! Location of CAS-JMP sequence
; 2051 LEN, ! Length of dispatch table
; 2052 TBL, ! Constant index of dispatch table
; 2053 BIAS, ! User's index to first word
; 2054 BRKHAK; ! Hack flag to handle omission of ['s
; 2055 SCAN();
; 2056 OPN = CPIEXP(OPN_TMP_INT);
; 2057 IF .OPN LSS 0 THEN ERROR('Index missing');
; 2058 IF .SCACOD NEQ SCN_FROM THEN ERROR('FROM missing');
; 2059 IF SCAN() NEQ SCN_NUMB THEN ERROR('Starting index missing');
; 2060 BIAS = .SCANUM;
; 2061 IF SCAN() NEQ SCN_TO THEN ERROR('TO missing');
; 2062 IF SCAN() NEQ SCN_NUMB THEN ERROR('Ending index missing');
; 2063 LEN = .SCANUM-.BIAS+1;
; 2064 IF .LEN LEQ 0 THEN ERROR('Invalid range');
; 2065 TBL = .CONSTP + 1;
; 2066 CONSTP = .CONSTP + .LEN + 2;
; 2067 IF .CONSTP GEQ CNSWKL THEN CERROR(CERM1);
; 2068 CNSWRK[.TBL] = .LEN; ! Table[0] = length of jump vector
; 2069 CNSWRK[.TBL-1] = -1; ! No OUTRANGE jump address yet
; 2070 DECR I FROM .LEN DO CNSWRK[.TBL+.I+1] = -1;
; 2071 LOC = GENINS(OPR_CAS,.OPN,.TBL,GETCNS(.BIAS,STE_TYP_INT));
; 2072 GENINS(OPR_JMP,0,0,0);
; 2073 IF SCAN() NEQ SCN_OF THEN CERROR(CERM20);
; 2074 IF SCAN() NEQ SCN_BEGIN THEN CERROR(CERM21);
; 2075
; 2076 DO
; 2077 BEGIN
; 2078 IF SCAN() EQL SCN_END THEN EXITLOOP;
; 2079 BRKHAK = 0; ! Assume no square brackets around labels
; 2080 IF .SCACOD EQL SCN_LBRKT
; 2081 THEN
; 2082 BEGIN
; 2083 BRKHAK = -1; ! We do have square brackets on this one
; 2084 SCAN() ! Read next token (skip over bracket)
; 2085 END;
; 2086 IF .SCACOD EQL SCN_NUMB
; 2087 THEN
; 2088 BEGIN
; 2089 IF .SCANUM LSS .BIAS OR .SCANUM GEQ .BIAS+.LEN
; 2090 THEN
; 2091 ERROR('Index out of range');
; 2092 CNSWRK[.TBL+1+.SCANUM-.BIAS] = .NEXTIN;
; 2093 END
; 2094 ELSE
; 2095 IF .SCACOD EQL SCN_INRANGE
; 2096 THEN
; 2097 DECR I FROM .LEN DO
; 2098 IF .CNSWRK[.TBL+1+.I] EQL -1 THEN CNSWRK[.TBL+1+.I] = .NEXTIN;
; 2099 IF .SCACOD EQL SCN_OUTRANGE
; 2100 THEN
; 2101 CNSWRK[.TBL-1] = .NEXTIN;
; 2102 IF SCAN() EQL SCN_RBRKT
; 2103 THEN
; 2104 BEGIN
; 2105 IF .BRKHAK NEQ 0
; 2106 THEN
; 2107 SCAN() ! Skip iff matching open bracket
; 2108 ELSE
; 2109 CERROR(CERM22)
; 2110 END
; 2111 ELSE
; 2112 IF .BRKHAK NEQ 0 THEN CERROR(CERM23); ! Complain if unmatched open
; 2113 IF .SCACOD NEQ SCN_COLON THEN CERROR(CERM11);
; 2114 SCAN();
; 2115 IF CPSTMT() EQL FALSE THEN CERROR(CERM12);
; 2116 GENINS(OPR_JMP,.LOC+2,0,0)
; 2117 END
; 2118 UNTIL
; 2119 .SCACOD NEQ SCN_SEMI;
; 2120 IF .SCACOD NEQ SCN_END THEN CERROR(CERM7);
; 2121 SCAN();
; 2122 CODWRK[.LOC+2,COD_OPA] = .NEXTIN
; 2123 END;
P.AFR: BYTE (7)"I","n","d","e","x" ; Index
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
P.AFS: BYTE (7)"F","R","O","M"," " ; FROM
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
P.AFT: BYTE (7)"S","t","a","r","t" ; Start
BYTE (7)"i","n","g"," ","i" ; ing i
BYTE (7)"n","d","e","x"," " ; ndex
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
P.AFU: BYTE (7)"T","O"," ","m","i" ; TO mi
BYTE (7)"s","s","i","n","g" ; ssing
BYTE (7)000,000,000,000,000
P.AFV: BYTE (7)"E","n","d","i","n" ; Endin
BYTE (7)"g"," ","i","n","d" ; g ind
BYTE (7)"e","x"," ","m","i" ; ex mi
BYTE (7)"s","s","i","n","g" ; ssing
BYTE (7)000,000,000,000,000
P.AFW: BYTE (7)"I","n","v","a","l" ; Inval
BYTE (7)"i","d"," ","r","a" ; id ra
BYTE (7)"n","g","e",000,000 ; nge
P.AFX: BYTE (7)"I","n","d","e","x" ; Index
BYTE (7)" ","o","u","t"," " ; out
BYTE (7)"o","f"," ","r","a" ; of ra
BYTE (7)"n","g","e",000,000 ; nge
CPCASE: PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
PUSHJ SP,SCAN ; SP,SCAN
MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
MOVE AC12,AC1 ; OPN,AC1
JUMPGE AC12,L.245 ; OPN,L.245
MOVEI AC1,P.AFR ; AC1,P.AFR
PUSHJ SP,CERROR ; SP,CERROR
L.245: MOVEI AC1,45 ; AC1,45
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.246 ; L.246
MOVEI AC1,P.AFS ; AC1,P.AFS
PUSHJ SP,CERROR ; SP,CERROR
L.246: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,2 ; AC1,2
JRST L.247 ; L.247
MOVEI AC1,P.AFT ; AC1,P.AFT
PUSHJ SP,CERROR ; SP,CERROR
L.247: MOVE AC10,SCANUM ; BIAS,SCANUM
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,46 ; AC1,46
JRST L.248 ; L.248
MOVEI AC1,P.AFU ; AC1,P.AFU
PUSHJ SP,CERROR ; SP,CERROR
L.248: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,2 ; AC1,2
JRST L.249 ; L.249
MOVEI AC1,P.AFV ; AC1,P.AFV
PUSHJ SP,CERROR ; SP,CERROR
L.249: MOVE AC1,SCANUM ; AC1,SCANUM
SUB AC1,AC10 ; AC1,BIAS
MOVE AC11,AC1 ; LEN,AC1
AOJG AC11,L.250 ; LEN,L.250
MOVEI AC1,P.AFW ; AC1,P.AFW
PUSHJ SP,CERROR ; SP,CERROR
L.250: MOVE AC14,CONSTP ; TBL,CONSTP
ADDI AC14,1 ; TBL,1
MOVE AC1,CONSTP ; AC1,CONSTP
ADD AC1,AC11 ; AC1,LEN
ADDI AC1,2 ; AC1,2
MOVEM AC1,CONSTP ; AC1,CONSTP
MOVEI AC1,6000 ; AC1,6000
CAMLE AC1,CONSTP ; AC1,CONSTP
JRST L.251 ; L.251
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.251: MOVEM AC11,CNSWRK(AC14) ; LEN,CNSWRK(TBL)
SETOM CNSWRK-1(AC14) ; CNSWRK-1(TBL)
MOVE AC1,AC11 ; I,LEN
AOJA AC1,L.253 ; I,L.253
L.252: MOVE AC3,AC14 ; AC3,TBL
ADD AC3,AC1 ; AC3,I
SETOM CNSWRK+1(AC3) ; CNSWRK+1(AC3)
L.253: SOJGE AC1,L.252 ; I,L.252
MOVE AC1,AC10 ; AC1,BIAS
SETZ AC2, ; AC2,
PUSHJ SP,GETCNS ; SP,GETCNS
MOVE AC4,AC1 ; AC4,AC1
MOVEI AC1,24 ; AC1,24
MOVE AC2,AC12 ; AC2,OPN
MOVE AC3,AC14 ; AC3,TBL
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC13,AC1 ; LOC,AC1
MOVEI AC1,30 ; AC1,30
SETZB AC2,AC3 ; AC2,AC3
SETZ AC4, ; AC4,
PUSHJ SP,GENINS ; SP,GENINS
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,47 ; AC1,47
JRST L.254 ; L.254
MOVEI AC1,CERM20 ; AC1,CERM20
PUSHJ SP,CERROR ; SP,CERROR
L.254: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,31 ; AC1,31
JRST L.255 ; L.255
MOVEI AC1,CERM21 ; AC1,CERM21
PUSHJ SP,CERROR ; SP,CERROR
L.255: ADDI AC13,2 ; LOC,2
L.256: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,32 ; AC1,32
JRST L.271 ; L.271
SETZ AC12, ; BRKHAK,
MOVEI AC1,23 ; AC1,23
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.257 ; L.257
SETO AC12, ; BRKHAK,
PUSHJ SP,SCAN ; SP,SCAN
L.257: MOVE AC1,SCACOD ; AC1,SCACOD
CAIE AC1,2 ; AC1,2
JRST L.260 ; L.260
CAMLE AC10,SCANUM ; BIAS,SCANUM
JRST L.258 ; L.258
MOVE AC1,AC10 ; AC1,BIAS
ADD AC1,AC11 ; AC1,LEN
CAMLE AC1,SCANUM ; AC1,SCANUM
JRST L.259 ; L.259
L.258: MOVEI AC1,P.AFX ; AC1,P.AFX
PUSHJ SP,CERROR ; SP,CERROR
L.259: MOVE AC1,SCANUM ; AC1,SCANUM
MOVE AC3,AC14 ; AC3,TBL
ADD AC3,AC1 ; AC3,AC1
SUB AC3,AC10 ; AC3,BIAS
MOVE AC1,NEXTIN ; AC1,NEXTIN
MOVEM AC1,CNSWRK+1(AC3) ; AC1,CNSWRK+1(AC3)
JRST L.263 ; L.263
L.260: CAIE AC1,50 ; AC1,50
JRST L.263 ; L.263
MOVE AC1,AC11 ; I,LEN
AOJA AC1,L.262 ; I,L.262
L.261: MOVE AC3,AC14 ; AC3,TBL
ADD AC3,AC1 ; AC3,I
SETO AC2, ; AC2,
CAME AC2,CNSWRK+1(AC3) ; AC2,CNSWRK+1(AC3)
JRST L.262 ; L.262
MOVE AC2,NEXTIN ; AC2,NEXTIN
MOVEM AC2,CNSWRK+1(AC3) ; AC2,CNSWRK+1(AC3)
L.262: SOJGE AC1,L.261 ; I,L.261
L.263: MOVEI AC1,51 ; AC1,51
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.264 ; L.264
MOVE AC1,NEXTIN ; AC1,NEXTIN
MOVEM AC1,CNSWRK-1(AC14) ; AC1,CNSWRK-1(TBL)
L.264: PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,24 ; AC1,24
JRST L.266 ; L.266
JUMPE AC12,L.265 ; BRKHAK,L.265
PUSHJ SP,SCAN ; SP,SCAN
JRST L.268 ; L.268
L.265: MOVEI AC1,CERM22 ; AC1,CERM22
JRST L.267 ; L.267
L.266: JUMPE AC12,L.268 ; BRKHAK,L.268
MOVEI AC1,CERM23 ; AC1,CERM23
L.267: PUSHJ SP,CERROR ; SP,CERROR
L.268: MOVEI AC1,22 ; AC1,22
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.269 ; L.269
MOVEI AC1,CERM11 ; AC1,CERM11
PUSHJ SP,CERROR ; SP,CERROR
L.269: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.270 ; AC1,L.270
MOVEI AC1,CERM12 ; AC1,CERM12
PUSHJ SP,CERROR ; SP,CERROR
L.270: MOVEI AC1,30 ; AC1,30
MOVE AC2,AC13 ; AC2,AC13
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.256 ; L.256
L.271: MOVEI AC1,32 ; AC1,32
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.272 ; L.272
MOVEI AC1,CERM7 ; AC1,CERM7
PUSHJ SP,CERROR ; SP,CERROR
L.272: PUSHJ SP,SCAN ; SP,SCAN
MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC13) ; AC1,CODWRK(AC13)
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
; Routine Size: 168 words
; 2124
; 2125 ROUTINE CPLOOP: NOVALUE = ! <Do-statement>
; 2126
; 2127 !++
; 2128 ! Functional description:
; 2129 ! Called from <Statement> to compile a DO statement. This may
; 2130 ! be a DO-WHILE, DO-UNTIL, WHILE-DO, or UNTIL-DO statement.
; 2131 !
; 2132 ! Formal parameters:
; 2133 ! None
; 2134 !
; 2135 ! Implicit inputs:
; 2136 ! Current atom, source
; 2137 !
; 2138 ! Implicit outputs:
; 2139 ! Code
; 2140 !
; 2141 ! Routine value:
; 2142 ! None
; 2143 !
; 2144 ! Side effects:
; 2145 ! Scans from statement keyword to unrecognized atom
; 2146 !
; 2147 !--
; 2148
; 2149 BEGIN
; 2150 EXTERNAL REGISTER Z=0;
; 2151 LOCAL
; 2152 TOPADR, ! Location of top of loop
; 2153 IFADDR; ! Location of compare instruction
; 2154 CASE .SCACOD FROM SCN_DO TO SCN_UNTIL OF
; 2155 SET
; 2156 [SCN_DO]: BEGIN
; 2157 LOCAL
; 2158 SWITCH;
; 2159 TOPADR = .NEXTIN;
; 2160 SCAN();
; 2161 IF CPSTMT() EQL FALSE THEN CERROR(CERM9);
; 2162 IF .SCACOD EQL SCN_WHILE OR .SCACOD EQL SCN_UNTIL
; 2163 THEN
; 2164 SWITCH = .SCACOD
; 2165 ELSE
; 2166 ERROR('WHILE or UNTIL missing');
; 2167 SCAN();
; 2168 IFADDR = CPLEXP();
; 2169 IF .SWITCH EQL SCN_WHILE
; 2170 THEN
; 2171 BEGIN
; 2172 CODWRK[.IFADDR,COD_OPA] = .IFADDR + 3;
; 2173 GENINS(OPR_JMP,.TOPADR,0,0)
; 2174 END
; 2175 ELSE
; 2176 CODWRK[.IFADDR,COD_OPA] = .TOPADR
; 2177 END;
; 2178 [SCN_WHILE]:BEGIN
; 2179 TOPADR = .NEXTIN;
; 2180 SCAN();
; 2181 IFADDR = CPLEXP();
; 2182 IF .SCACOD NEQ SCN_DO THEN ERROR('DO missing after WHILE');
; 2183 SCAN();
; 2184 IF CPSTMT() EQL FALSE THEN CERROR(CERM9);
; 2185 GENINS(OPR_JMP,.TOPADR,0,0);
; 2186 CODWRK[.IFADDR,COD_OPA] = .NEXTIN
; 2187 END;
; 2188 [SCN_UNTIL]:BEGIN
; 2189 TOPADR = .NEXTIN;
; 2190 SCAN();
; 2191 IFADDR = CPLEXP();
; 2192 GENINS(OPR_JMP,0,0,0);
; 2193 CODWRK[.IFADDR,COD_OPA] = .NEXTIN;
; 2194 IF .SCACOD NEQ SCN_DO THEN ERROR('DO missing after UNTIL');
; 2195 SCAN();
; 2196 IF CPSTMT() EQL FALSE THEN CERROR(CERM9);
; 2197 GENINS(OPR_JMP,.TOPADR,0,0);
; 2198 CODWRK[.IFADDR+2,COD_OPA] = .NEXTIN
; 2199 END
; 2200 TES
; 2201 END;
P.AFY: BYTE (7)"W","H","I","L","E" ; WHILE
BYTE (7)" ","o","r"," ","U" ; or U
BYTE (7)"N","T","I","L"," " ; NTIL
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
P.AFZ: BYTE (7)"D","O"," ","m","i" ; DO mi
BYTE (7)"s","s","i","n","g" ; ssing
BYTE (7)" ","a","f","t","e" ; afte
BYTE (7)"r"," ","W","H","I" ; r WHI
BYTE (7)"L","E",000,000,000 ; LE
P.AGA: BYTE (7)"D","O"," ","m","i" ; DO mi
BYTE (7)"s","s","i","n","g" ; ssing
BYTE (7)" ","a","f","t","e" ; afte
BYTE (7)"r"," ","U","N","T" ; r UNT
BYTE (7)"I","L",000,000,000 ; IL
CPLOOP: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC1,SCACOD ; AC1,SCACOD
SUBI AC1,52 ; AC1,52
JRST L.273(AC1) ; L.273(AC1)
L.273: JRST L.274 ; L.274
JRST L.280 ; L.280
JRST L.283 ; L.283
L.274: MOVE AC12,NEXTIN ; TOPADR,NEXTIN
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.275 ; AC1,L.275
MOVEI AC1,CERM9 ; AC1,CERM9
PUSHJ SP,CERROR ; SP,CERROR
L.275: MOVE AC1,SCACOD ; AC1,SCACOD
CAIN AC1,53 ; AC1,53
JRST L.276 ; L.276
CAIE AC1,54 ; AC1,54
JRST L.277 ; L.277
L.276: MOVE AC13,AC1 ; SWITCH,AC1
JRST L.278 ; L.278
L.277: MOVEI AC1,P.AFY ; AC1,P.AFY
PUSHJ SP,CERROR ; SP,CERROR
L.278: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPLEXP ; SP,CPLEXP
MOVE AC14,AC1 ; IFADDR,AC1
CAIE AC13,53 ; SWITCH,53
JRST L.279 ; L.279
MOVE AC1,AC14 ; AC1,IFADDR
ADDI AC1,3 ; AC1,3
HRRM AC1,CODWRK(AC14) ; AC1,CODWRK(IFADDR)
MOVEI AC1,30 ; AC1,30
MOVE AC2,AC12 ; AC2,TOPADR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
JRST L.286 ; L.286
L.279: HRRM AC12,CODWRK(AC14) ; TOPADR,CODWRK(IFADDR)
JRST L.286 ; L.286
L.280: MOVE AC12,NEXTIN ; TOPADR,NEXTIN
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPLEXP ; SP,CPLEXP
MOVE AC14,AC1 ; IFADDR,AC1
MOVEI AC1,52 ; AC1,52
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.281 ; L.281
MOVEI AC1,P.AFZ ; AC1,P.AFZ
PUSHJ SP,CERROR ; SP,CERROR
L.281: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.282 ; AC1,L.282
MOVEI AC1,CERM9 ; AC1,CERM9
PUSHJ SP,CERROR ; SP,CERROR
L.282: MOVEI AC1,30 ; AC1,30
MOVE AC2,AC12 ; AC2,TOPADR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC14) ; AC1,CODWRK(IFADDR)
JRST L.286 ; L.286
L.283: MOVE AC12,NEXTIN ; TOPADR,NEXTIN
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPLEXP ; SP,CPLEXP
MOVE AC14,AC1 ; IFADDR,AC1
MOVEI AC1,30 ; AC1,30
SETZB AC2,AC3 ; AC2,AC3
SETZ AC4, ; AC4,
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC14) ; AC1,CODWRK(IFADDR)
MOVEI AC1,52 ; AC1,52
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.284 ; L.284
MOVEI AC1,P.AGA ; AC1,P.AGA
PUSHJ SP,CERROR ; SP,CERROR
L.284: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.285 ; AC1,L.285
MOVEI AC1,CERM9 ; AC1,CERM9
PUSHJ SP,CERROR ; SP,CERROR
L.285: MOVEI AC1,30 ; AC1,30
MOVE AC2,AC12 ; AC2,TOPADR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK+2(AC14) ; AC1,CODWRK+2(IFADDR)
L.286: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 90 words
; 2202
; 2203 ROUTINE CPSELE: NOVALUE = ! <Select-statement>
; 2204
; 2205 !++
; 2206 ! Functional description:
; 2207 ! Called from <Statement> to compile a Select statement.
; 2208 !
; 2209 ! Formal parameters:
; 2210 ! None
; 2211 !
; 2212 ! Implicit inputs:
; 2213 ! Source
; 2214 !
; 2215 ! Implicit outputs:
; 2216 ! Code
; 2217 !
; 2218 ! Routine value:
; 2219 ! None
; 2220 !
; 2221 ! Side effects:
; 2222 ! Scans from Select to unrecognized atom
; 2223 !
; 2224 !--
; 2225
; 2226 BEGIN
; 2227 EXTERNAL REGISTER Z=0;
; 2228 LOCAL
; 2229 SDESC, ! Select-expression operand descriptor
; 2230 TDESC, ! Test-expression operand descriptor
; 2231 TESTADDR, ! Location of comparison instruction
; 2232 EXITADDR, ! Location of last JMP instruction to exit
; 2233 TYPE, ! Data type of test
; 2234 OPR, ! Comparison operation code
; 2235 BRKHAK; ! Hack flag to handle omission of ['s
; 2236
; 2237 SCAN();
; 2238 TYPE = CPCLSE();
; 2239 IF .TYPE LSS 0 THEN CERROR(CERM18);
; 2240 IF .TYPE EQL STE_TYP_INT
; 2241 THEN
; 2242 BEGIN
; 2243 SDESC = CPIEXP(OPN_TMP_INT);
; 2244 OPR = OPR_BNE
; 2245 END
; 2246 ELSE
; 2247 BEGIN
; 2248 SDESC = CPSEXP(OPN_TMP_STR);
; 2249 OPR = OPR_CNE
; 2250 END;
; 2251 IF .SCACOD NEQ SCN_OF THEN CERROR(CERM20);
; 2252 IF SCAN() NEQ SCN_BEGIN THEN CERROR(CERM21);
; 2253 EXITADDR = %O'777777';
; 2254
; 2255 DO
; 2256 BEGIN
; 2257 IF SCAN() EQL SCN_END THEN EXITLOOP;
; 2258 BRKHAK = 0; ! Assume no square brackets around labels
; 2259 IF .SCACOD EQL SCN_LBRKT
; 2260 THEN
; 2261 BEGIN
; 2262 BRKHAK = -1; ! We do have square brackets on this one
; 2263 SCAN() ! Read next token (skip over bracket)
; 2264 END;
; 2265 IF .SCACOD EQL SCN_OTHERWISE
; 2266 THEN
; 2267 BEGIN
; 2268 SCAN();
; 2269 TESTADDR = -1
; 2270 END
; 2271 ELSE
; 2272 BEGIN
; 2273 IF .SDESC EQL OPN_TMP_INT OR .SDESC EQL OPN_TMP_STR
; 2274 THEN
; 2275 GENINS(OPR_PSH,.SDESC,0,0);
; 2276 IF .TYPE EQL STE_TYP_INT
; 2277 THEN
; 2278 TDESC = CPIEXP(OPN_TMP_INT)
; 2279 ELSE
; 2280 TDESC = CPSEXP(OPN_TMP_STR);
; 2281 TESTADDR = .NEXTIN;
; 2282 GENINS(.OPR,0,.SDESC,.TDESC)
; 2283 END;
; 2284 IF .SCACOD EQL SCN_RBRKT
; 2285 THEN
; 2286 BEGIN
; 2287 IF .BRKHAK NEQ 0
; 2288 THEN
; 2289 SCAN() ! Skip iff matching open bracket
; 2290 ELSE
; 2291 CERROR(CERM22)
; 2292 END
; 2293 ELSE
; 2294 IF .BRKHAK NEQ 0 THEN CERROR(CERM23); ! Complain if unmatched open
; 2295 IF .SCACOD NEQ SCN_COLON THEN CERROR(CERM11);
; 2296 SCAN();
; 2297 IF CPSTMT() EQL FALSE THEN CERROR(CERM12);
; 2298 EXITADDR = GENINS(OPR_JMP,.EXITADDR,0,0);
; 2299 IF .TESTADDR GEQ 0 THEN CODWRK[.TESTADDR,COD_OPA] = .NEXTIN
; 2300 END
; 2301 UNTIL
; 2302 .SCACOD NEQ SCN_SEMI;
; 2303 IF .SCACOD NEQ SCN_END THEN CERROR(CERM7);
; 2304 SCAN();
; 2305 WHILE
; 2306 .EXITADDR NEQ %O'777777'
; 2307 DO
; 2308 BEGIN
; 2309 TESTADDR = .CODWRK[.EXITADDR,COD_OPA];
; 2310 CODWRK[.EXITADDR,COD_OPA] = .NEXTIN;
; 2311 EXITADDR = .TESTADDR
; 2312 END;
; 2313 IF .SDESC EQL OPN_TMP_INT OR .SDESC EQL OPN_TMP_STR
; 2314 THEN
; 2315 GENINS(OPR_POP,.SDESC,0,0)
; 2316 END;
CPSELE: PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,2 ; SP,2
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPCLSE ; SP,CPCLSE
MOVE AC13,AC1 ; TYPE,AC1
JUMPGE AC13,L.287 ; TYPE,L.287
MOVEI AC1,CERM18 ; AC1,CERM18
PUSHJ SP,CERROR ; SP,CERROR
L.287: SETZM 0(SP) ; 0(SP)
JUMPN AC13,L.288 ; TYPE,L.288
MOVEI AC1,1 ; AC1,1
MOVEM AC1,0(SP) ; AC1,0(SP)
MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
MOVE AC12,AC1 ; SDESC,AC1
MOVEI AC10,12 ; OPR,12
JRST L.289 ; L.289
L.288: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
MOVE AC12,AC1 ; SDESC,AC1
MOVEI AC10,20 ; OPR,20
L.289: MOVEI AC1,47 ; AC1,47
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.290 ; L.290
MOVEI AC1,CERM20 ; AC1,CERM20
PUSHJ SP,CERROR ; SP,CERROR
L.290: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,31 ; AC1,31
JRST L.291 ; L.291
MOVEI AC1,CERM21 ; AC1,CERM21
PUSHJ SP,CERROR ; SP,CERROR
L.291: MOVEI AC14,-1 ; EXITADDR,-1
L.292: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,32 ; AC1,32
JRST L.307 ; L.307
SETZ AC11, ; BRKHAK,
MOVEI AC1,23 ; AC1,23
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.293 ; L.293
SETO AC11, ; BRKHAK,
PUSHJ SP,SCAN ; SP,SCAN
L.293: MOVEI AC1,62 ; AC1,62
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.294 ; L.294
PUSHJ SP,SCAN ; SP,SCAN
SETO AC13, ; TESTADDR,
JRST L.299 ; L.299
L.294: CAIN AC12,-200000 ; SDESC,-200000
JRST L.295 ; L.295
CAIE AC12,-100000 ; SDESC,-100000
JRST L.296 ; L.296
L.295: MOVEI AC1,45 ; AC1,45
MOVE AC2,AC12 ; AC2,SDESC
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
L.296: MOVEI AC1,1 ; AC1,1
TDNN AC1,0(SP) ; AC1,0(SP)
JRST L.297 ; L.297
MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
JRST L.298 ; L.298
L.297: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
L.298: MOVEM AC1,-1(SP) ; AC1,TDESC
MOVE AC13,NEXTIN ; TESTADDR,NEXTIN
MOVE AC1,AC10 ; AC1,OPR
SETZ AC2, ; AC2,
MOVE AC3,AC12 ; AC3,SDESC
MOVE AC4,-1(SP) ; AC4,TDESC
PUSHJ SP,GENINS ; SP,GENINS
L.299: MOVEI AC1,24 ; AC1,24
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.301 ; L.301
JUMPE AC11,L.300 ; BRKHAK,L.300
PUSHJ SP,SCAN ; SP,SCAN
JRST L.303 ; L.303
L.300: MOVEI AC1,CERM22 ; AC1,CERM22
JRST L.302 ; L.302
L.301: JUMPE AC11,L.303 ; BRKHAK,L.303
MOVEI AC1,CERM23 ; AC1,CERM23
L.302: PUSHJ SP,CERROR ; SP,CERROR
L.303: MOVEI AC1,22 ; AC1,22
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.304 ; L.304
MOVEI AC1,CERM11 ; AC1,CERM11
PUSHJ SP,CERROR ; SP,CERROR
L.304: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.305 ; AC1,L.305
MOVEI AC1,CERM12 ; AC1,CERM12
PUSHJ SP,CERROR ; SP,CERROR
L.305: MOVEI AC1,30 ; AC1,30
MOVE AC2,AC14 ; AC2,EXITADDR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC14,AC1 ; EXITADDR,AC1
JUMPL AC13,L.306 ; TESTADDR,L.306
MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC13) ; AC1,CODWRK(TESTADDR)
L.306: MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.292 ; L.292
L.307: MOVEI AC1,32 ; AC1,32
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.308 ; L.308
MOVEI AC1,CERM7 ; AC1,CERM7
PUSHJ SP,CERROR ; SP,CERROR
L.308: PUSHJ SP,SCAN ; SP,SCAN
L.309: CAIN AC14,-1 ; EXITADDR,-1
JRST L.310 ; L.310
HRRZ AC13,CODWRK(AC14) ; TESTADDR,CODWRK(EXITADDR)
MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC14) ; AC1,CODWRK(EXITADDR)
MOVE AC14,AC13 ; EXITADDR,TESTADDR
JRST L.309 ; L.309
L.310: CAIN AC12,-200000 ; SDESC,-200000
JRST L.311 ; L.311
CAIE AC12,-100000 ; SDESC,-100000
JRST L.312 ; L.312
L.311: MOVEI AC1,46 ; AC1,46
MOVE AC2,AC12 ; AC2,SDESC
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
L.312: ADJSP SP,-2 ; SP,-2
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
; Routine Size: 134 words
; 2317
; 2318 ROUTINE CPCOMS(OPCODE,REQVAR): NOVALUE = ! Common string statement
; 2319
; 2320 !++
; 2321 ! Functional description:
; 2322 ! Called from <Statement> to compile any sort of statement
; 2323 ! which is merely an operation code with a string argument.
; 2324 ! The string may be required to be a string identifier, or
; 2325 ! be allowed to be a string-expression.
; 2326 !
; 2327 ! Formal parameters:
; 2328 ! Operation code of the instruction to be generated
; 2329 ! Switch: Require variable if 1, otherwise permit any string-expression
; 2330 !
; 2331 ! Implicit inputs:
; 2332 ! Source
; 2333 !
; 2334 ! Implicit outputs:
; 2335 ! Code
; 2336 !
; 2337 ! Routine value:
; 2338 ! None
; 2339 !
; 2340 ! Side effects:
; 2341 ! Scans from statement keyword to unrecognized atom
; 2342 !
; 2343 !--
; 2344
; 2345 BEGIN
; 2346 EXTERNAL REGISTER Z=0;
; 2347 SCAN();
; 2348 IF .REQVAR NEQ 0 AND .SCACOD NEQ SCN_IDENT AND .SCACOD NEQ SCN_SYSNAME
; 2349 THEN
; 2350 CERROR(CERM3);
; 2351 GENINS(.OPCODE,CPSEXP(OPN_TMP_STR),0,0)
; 2352 END;
CPCOMS: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC2 ; REQVAR,AC2
MOVE AC13,AC1 ; OPCODE,AC1
PUSHJ SP,SCAN ; SP,SCAN
JUMPE AC14,L.313 ; REQVAR,L.313
MOVEI AC1,1 ; AC1,1
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.313 ; L.313
MOVEI AC1,112 ; AC1,112
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.313 ; L.313
MOVEI AC1,CERM3 ; AC1,CERM3
PUSHJ SP,CERROR ; SP,CERROR
L.313: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
MOVE AC2,AC1 ; AC2,AC1
MOVE AC1,AC13 ; AC1,OPCODE
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 23 words
; 2353
; 2354 ROUTINE CPPFRM: NOVALUE = ! <DoCommand-statement>
; 2355
; 2356 !++
; 2357 ! Functional description:
; 2358 ! Called from <Statement> to compile a DoCommand statement.
; 2359 !
; 2360 ! Formal parameters:
; 2361 ! None
; 2362 !
; 2363 ! Implicit inputs:
; 2364 ! Source
; 2365 !
; 2366 ! Implicit outputs:
; 2367 ! Code
; 2368 !
; 2369 ! Routine value:
; 2370 ! None
; 2371 !
; 2372 ! Side effects:
; 2373 ! Scans from DOCOMMAND to unrecognized atom
; 2374 !
; 2375 !--
; 2376
; 2377 BEGIN
; 2378 EXTERNAL REGISTER Z=0;
; 2379 LOCAL
; 2380 OPA, ! Operand descriptors
; 2381 OPB,
; 2382 OPC;
; 2383 OPB = -1;
; 2384 OPC = -1;
; 2385 IF SCAN() EQL SCN_ORIGINAL
; 2386 THEN
; 2387 BEGIN
; 2388 OPB = 0;
; 2389 SCAN()
; 2390 END;
; 2391 OPA = CPSEXP(OPN_TMP_STR);
; 2392 IF .SCACOD EQL SCN_TO
; 2393 THEN
; 2394 BEGIN
; 2395 ! IF SCAN() NEQ SCN_IDENT THEN CERROR(CERM3);
; 2396 ! OPC = CPSEXP(OPN_TMP_STR)
; 2397 IF SCAN() EQL SCN_IDENT
; 2398 THEN
; 2399 OPC = CPSPRM()
; 2400 ELSE IF .SCACOD EQL SCN_SYSNAME
; 2401 THEN
; 2402 BEGIN
; 2403 IF .PSDEFN[.SCATOM,SYN_CLS] NEQ SYN_CLS_VAR
; 2404 THEN
; 2405 ERROR('Cannot store into routine');
; 2406 IF NOT .PSDEFN[.SCATOM,SYN_WRT]
; 2407 THEN
; 2408 ERROR('Variable is readonly');
; 2409 OPC = CPSPRM()
; 2410 END
; 2411 ELSE
; 2412 CERROR(CERM3);
; 2413 IF .SCACOD EQL SCN_PLUS
; 2414 THEN
; 2415 ERROR('Complex string expression illegal after TO')
; 2416 END;
; 2417 GENINS(OPR_DCM,.OPA,.OPB,.OPC)
; 2418 END;
P.AGB: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","s","t","o" ; t sto
BYTE (7)"r","e"," ","i","n" ; re in
BYTE (7)"t","o"," ","r","o" ; to ro
BYTE (7)"u","t","i","n","e" ; utine
BYTE (7)000,000,000,000,000
P.AGC: BYTE (7)"V","a","r","i","a" ; Varia
BYTE (7)"b","l","e"," ","i" ; ble i
BYTE (7)"s"," ","r","e","a" ; s rea
BYTE (7)"d","o","n","l","y" ; donly
BYTE (7)000,000,000,000,000
P.AGD: BYTE (7)"C","o","m","p","l" ; Compl
BYTE (7)"e","x"," ","s","t" ; ex st
BYTE (7)"r","i","n","g"," " ; ring
BYTE (7)"e","x","p","r","e" ; expre
BYTE (7)"s","s","i","o","n" ; ssion
BYTE (7)" ","i","l","l","e" ; ille
BYTE (7)"g","a","l"," ","a" ; gal a
BYTE (7)"f","t","e","r"," " ; fter
BYTE (7)"T","O",000,000,000 ; TO
CPPFRM: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
SETOB AC14,AC13 ; OPB,OPC
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,57 ; AC1,57
JRST L.314 ; L.314
SETZ AC14, ; OPB,
PUSHJ SP,SCAN ; SP,SCAN
L.314: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
MOVE AC12,AC1 ; OPA,AC1
MOVEI AC1,46 ; AC1,46
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.319 ; L.319
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.316 ; L.316
MOVEI AC1,112 ; AC1,112
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.317 ; L.317
MOVE AC1,SCATOM ; AC1,SCATOM
IMULI AC1,2 ; AC1,2
LDB AC2,C.31 ; AC2,[POINT 3,PSDEFN(AC1),17] <18,3>
CAIN AC2,2 ; AC2,2
JRST L.315 ; L.315
MOVEI AC1,P.AGB ; AC1,P.AGB
PUSHJ SP,CERROR ; SP,CERROR
L.315: MOVE AC1,SCATOM ; AC1,SCATOM
IMULI AC1,2 ; AC1,2
MOVSI AC2,200000 ; AC2,200000
TDNE AC2,PSDEFN(AC1) ; AC2,PSDEFN(AC1)
JRST L.316 ; L.316
MOVEI AC1,P.AGC ; AC1,P.AGC
PUSHJ SP,CERROR ; SP,CERROR
L.316: PUSHJ SP,CPSPRM ; SP,CPSPRM
MOVE AC13,AC1 ; OPC,AC1
JRST L.318 ; L.318
L.317: MOVEI AC1,CERM3 ; AC1,CERM3
PUSHJ SP,CERROR ; SP,CERROR
L.318: MOVEI AC1,4 ; AC1,4
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.319 ; L.319
MOVEI AC1,P.AGD ; AC1,P.AGD
PUSHJ SP,CERROR ; SP,CERROR
L.319: MOVEI AC1,27 ; AC1,27
MOVE AC2,AC12 ; AC2,OPA
MOVE AC3,AC14 ; AC3,OPB
MOVE AC4,AC13 ; AC4,OPC
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 54 words
; 2419
; 2420 ROUTINE CPGUID: NOVALUE = ! <Guide-statement>
; 2421
; 2422 !++
; 2423 ! Functional description:
; 2424 ! Called from <Statement> to compile a Guide statement.
; 2425 ! It's just an Parse statement, but the FLDDB takes no work.
; 2426 !
; 2427 ! Formal parameters:
; 2428 ! None
; 2429 !
; 2430 ! Implicit inputs:
; 2431 ! Source
; 2432 !
; 2433 ! Implicit outputs:
; 2434 ! Code
; 2435 !
; 2436 ! Routine value:
; 2437 ! None
; 2438 !
; 2439 ! Side effects:
; 2440 ! Scans from GUIDE to unrecognized atom
; 2441 !
; 2442 !--
; 2443
; 2444 BEGIN
; 2445 EXTERNAL REGISTER Z=0;
; 2446 LOCAL
; 2447 FDB;
; 2448 IF .CMDARG EQL -1 THEN CMDARG = -2;
; 2449 FDB = .CONSTP;
; 2450 CONSTP = .CONSTP + $CMBRK + 1;
; 2451 CNSWRK[.FDB+$CMFNP] = 0;
; 2452 CNSWRK[.FDB+$CMDAT] = 0;
; 2453 CNSWRK[.FDB+$CMDEF] = 0;
; 2454 CNSWRK[.FDB+$CMHLP] = 0;
; 2455 CNSWRK[.FDB+$CMBRK] = 0;
; 2456 POINTR((CNSWRK[.FDB+$CMFNP]),CM_FNC) = $CMNOI;
; 2457 IF SCAN() NEQ SCN_QSTRING THEN CERROR(CERM19);
; 2458 CNSWRK[.FDB+$CMDAT] = CPSPRM();
; 2459 CNSWRK[.FDB+$CMBRK] = .NEXTIN + 2;
; 2460 GENINS(OPR_PRS,.FDB,0,-1)
; 2461 END;
CPGUID: PUSH SP,AC14 ; SP,AC14
SETO AC1, ; AC1,
CAME AC1,CMDARG ; AC1,CMDARG
JRST L.320 ; L.320
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,CMDARG ; AC1,CMDARG
L.320: MOVE AC14,CONSTP ; FDB,CONSTP
MOVEI AC1,5 ; AC1,5
ADDM AC1,CONSTP ; AC1,CONSTP
SETZM CNSWRK(AC14) ; CNSWRK(FDB)
SETZM CNSWRK+1(AC14) ; CNSWRK+1(FDB)
SETZM CNSWRK+3(AC14) ; CNSWRK+3(FDB)
SETZM CNSWRK+2(AC14) ; CNSWRK+2(FDB)
SETZM CNSWRK+4(AC14) ; CNSWRK+4(FDB)
MOVEI AC1,2 ; AC1,2
DPB AC1,C.34 ; AC1,[POINT 9,CNSWRK(FDB),8] <27,9>
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,3 ; AC1,3
JRST L.321 ; L.321
MOVEI AC1,CERM19 ; AC1,CERM19
PUSHJ SP,CERROR ; SP,CERROR
L.321: PUSHJ SP,CPSPRM ; SP,CPSPRM
MOVEM AC1,CNSWRK+1(AC14) ; AC1,CNSWRK+1(FDB)
MOVE AC1,NEXTIN ; AC1,NEXTIN
ADDI AC1,2 ; AC1,2
MOVEM AC1,CNSWRK+4(AC14) ; AC1,CNSWRK+4(FDB)
MOVEI AC1,25 ; AC1,25
MOVE AC2,AC14 ; AC2,FDB
SETZ AC3, ; AC3,
SETO AC4, ; AC4,
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
C.34: POINT 9,CNSWRK(AC14),8 ; 9,CNSWRK(FDB),8
; Routine Size: 34 words
; 2462
; 2463 ROUTINE CPPMPT: NOVALUE = ! <Prompt-statement>
; 2464
; 2465 !++
; 2466 ! Functional description:
; 2467 ! Compiles a Prompt statement.
; 2468 !
; 2469 ! Formal parameters:
; 2470 ! None
; 2471 !
; 2472 ! Implicit inputs:
; 2473 ! Source
; 2474 !
; 2475 ! Implicit outputs:
; 2476 ! Instruction
; 2477 !
; 2478 ! Routine value:
; 2479 ! None
; 2480 !
; 2481 ! Side effects:
; 2482 ! Scans from PROMPT to unrecognized atom
; 2483 !
; 2484 !--
; 2485
; 2486 BEGIN
; 2487 EXTERNAL REGISTER Z=0;
; 2488 LOCAL OPR; ! Operation code to use
; 2489 OPR = OPR_PMT;
; 2490 IF SCAN() EQL SCN_NOECHO
; 2491 THEN
; 2492 BEGIN
; 2493 OPR = OPR_PMN;
; 2494 SCAN();
; 2495 END;
; 2496 GENINS(.OPR,CPSEXP(OPN_TMP_STR),0,0)
; 2497 END;
CPPMPT: PUSH SP,AC14 ; SP,AC14
MOVEI AC14,47 ; OPR,47
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,111 ; AC1,111
JRST L.322 ; L.322
MOVEI AC14,50 ; OPR,50
PUSHJ SP,SCAN ; SP,SCAN
L.322: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
MOVE AC2,AC1 ; AC2,AC1
MOVE AC1,AC14 ; AC1,OPR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 15 words
; 2498
; 2499 ROUTINE CPINVK: NOVALUE = ! <Invoke-statement>
; 2500
; 2501 !++
; 2502 ! Functional description:
; 2503 ! Compile an Invoke statement.
; 2504 !
; 2505 ! Formal parameters:
; 2506 ! None
; 2507 !
; 2508 ! Implicit inputs:
; 2509 ! Source
; 2510 !
; 2511 ! Implicit outputs:
; 2512 ! Instructions
; 2513 !
; 2514 ! Routine value:
; 2515 ! None
; 2516 !
; 2517 ! Side effects:
; 2518 ! None
; 2519 !
; 2520 !--
; 2521
; 2522 BEGIN
; 2523 EXTERNAL REGISTER Z=0;
; 2524 LOCAL OPR;
; 2525 OPR = OPR_IVP;
; 2526 IF SCAN() EQL SCN_PASSOUTPUT
; 2527 THEN
; 2528 BEGIN
; 2529 OPR = OPR_IVO;
; 2530 SCAN()
; 2531 END;
; 2532 GENINS(.OPR,CPSEXP(OPN_TMP_STR),0,0)
; 2533 END;
CPINVK: PUSH SP,AC14 ; SP,AC14
MOVEI AC14,32 ; OPR,32
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,114 ; AC1,114
JRST L.323 ; L.323
MOVEI AC14,51 ; OPR,51
PUSHJ SP,SCAN ; SP,SCAN
L.323: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
MOVE AC2,AC1 ; AC2,AC1
MOVE AC1,AC14 ; AC1,OPR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 15 words
; 2534
; 2535 ROUTINE CPPRSE: NOVALUE = ! <Parse-statement>
; 2536
; 2537 !++
; 2538 ! Functional description:
; 2539 ! Called from <Statement> to compile an Parse statement,
; 2540 ! generating the corresponding list of Field Descriptor Blocks
; 2541 ! and the Parse instruction referencing it.
; 2542 !
; 2543 ! Formal parameters:
; 2544 ! None
; 2545 !
; 2546 ! Implicit inputs:
; 2547 ! Source
; 2548 !
; 2549 ! Implicit outputs:
; 2550 ! Code, constants
; 2551 !
; 2552 ! Routine value:
; 2553 ! None
; 2554 !
; 2555 ! Side effects:
; 2556 ! Scans from PARSE to unrecognized atom
; 2557 !
; 2558 !--
; 2559
; 2560 BEGIN
; 2561 EXTERNAL REGISTER Z=0;
; 2562 LOCAL
; 2563 PRSINSTR, ! Location of PRS instruction
; 2564 FAILADDR, ! Location of failure instruction
; 2565 FDB; ! Constant index of FLDDB list
; 2566 IF .CMDARG EQL -1 THEN CMDARG = -2;
; 2567 PRSINSTR = GENINS(OPR_PRS,0,0,0);
; 2568 GENINS(OPR_JMP,0,0,0);
; 2569 FAILADDR = -1;
; 2570 SCAN();
; 2571 IF (.SCACOD EQL SCN_LPAREN) OR (.SCACOD EQL SCN_BEGIN)
; 2572 THEN
; 2573 BEGIN
; 2574 LOCAL
; 2575 LFDB, ! Last FLDDB built
; 2576 NFDB, ! New FLDDB
; 2577 FILOPT, ! Whether a File parse is on the list
; 2578 PRNHAK; ! Hack flag for old syntax
; 2579 IF .SCACOD EQL SCN_LPAREN
; 2580 THEN
; 2581 PRNHAK = -1
; 2582 ELSE
; 2583 PRNHAK = 0;
; 2584 LFDB = -1;
; 2585 FILOPT = 0;
; 2586 SCAN();
; 2587 DO
; 2588 BEGIN
; 2589 ! Identify the parse-type
; 2590 NFDB = CPPRSI(0,.PRSINSTR+2);
; 2591 ! Handle OTHERWISE, which must be last before the ")"
; 2592 IF .NFDB LSS 0
; 2593 THEN
; 2594 BEGIN
; 2595 FAILADDR = -.NFDB;
; 2596 IF .SCACOD EQL SCN_SEMI THEN SCAN();
; 2597 EXITLOOP
; 2598 END;
; 2599 IF .POINTR((CNSWRK[.NFDB+$CMFNP]),CM_FNC) EQL $CMFIL
; 2600 THEN
; 2601 IF .FILOPT EQL 0
; 2602 THEN
; 2603 FILOPT = -1
; 2604 ELSE
; 2605 ERROR('Cannot have two File fields in one Parse');
; 2606 IF .LFDB LSS 0
; 2607 THEN
; 2608 FDB = .NFDB
; 2609 ELSE
; 2610 BEGIN
; 2611 IF .POINTR((CNSWRK[.LFDB+$CMFNP]),CM_FNC) EQL $CMNOI
; 2612 THEN
; 2613 ERROR('Cannot chain Noise field-type to another type');
; 2614 IF .POINTR((CNSWRK[.LFDB+$CMFNP]),CM_FNC) EQL $CMFLS
; 2615 THEN
; 2616 ERROR('Cannot chain FileList field-type to another type');
; 2617 IF .POINTR((CNSWRK[.NFDB+$CMFNP]),CM_FNC) EQL $CMFLS
; 2618 THEN
; 2619 ERROR('Cannot chain any other field-type to FileList');
; 2620 POINTR((CNSWRK[.LFDB+$CMFNP]),CM_LST) = .NFDB
; 2621 END;
; 2622 LFDB = .NFDB;
; 2623 IF .SCACOD NEQ SCN_SEMI AND .SCACOD NEQ SCN_RPAREN
; 2624 AND .SCACOD NEQ SCN_END
; 2625 THEN
; 2626 CERROR(CERM14);
; 2627 IF .SCACOD EQL SCN_SEMI THEN SCAN();
; 2628 IF (.PRNHAK NEQ 0) AND (.SCACOD EQL SCN_END)
; 2629 THEN
; 2630 CERROR(CERM14);
; 2631 IF (.PRNHAK EQL 0) AND (.SCACOD EQL SCN_RPAREN)
; 2632 THEN
; 2633 CERROR(CERM7)
; 2634 END
; 2635 UNTIL
; 2636 .SCACOD EQL SCN_RPAREN OR .SCACOD EQL SCN_END;
; 2637 SCAN()
; 2638 END
; 2639 ELSE
; 2640 BEGIN
; 2641 FDB = CPPRSI(0,.PRSINSTR+2);
; 2642 IF .FDB LSS 0 THEN ERROR('OTHERWISE meaningless here');
; 2643 IF .SCACOD NEQ SCN_SEMI AND .SCACOD NEQ SCN_END
; 2644 AND .SCACOD NEQ SCN_RPAREN AND .SCACOD NEQ SCN_ELSE
; 2645 THEN
; 2646 ERROR('Garbage following PARSE')
; 2647 END;
; 2648 CODWRK[.PRSINSTR,COD_OPA] = .FDB;
; 2649 CODWRK[.PRSINSTR,COD_OPC] = .FAILADDR;
; 2650 CODWRK[.PRSINSTR+2,COD_OPA] = .NEXTIN
; 2651 END;
P.AGE: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","h","a","v" ; t hav
BYTE (7)"e"," ","t","w","o" ; e two
BYTE (7)" ","F","i","l","e" ; File
BYTE (7)" ","f","i","e","l" ; fiel
BYTE (7)"d","s"," ","i","n" ; ds in
BYTE (7)" ","o","n","e"," " ; one
BYTE (7)"P","a","r","s","e" ; Parse
BYTE (7)000,000,000,000,000
P.AGF: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","c","h","a" ; t cha
BYTE (7)"i","n"," ","N","o" ; in No
BYTE (7)"i","s","e"," ","f" ; ise f
BYTE (7)"i","e","l","d","-" ; ield-
BYTE (7)"t","y","p","e"," " ; type
BYTE (7)"t","o"," ","a","n" ; to an
BYTE (7)"o","t","h","e","r" ; other
BYTE (7)" ","t","y","p","e" ; type
BYTE (7)000,000,000,000,000
P.AGG: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","c","h","a" ; t cha
BYTE (7)"i","n"," ","F","i" ; in Fi
BYTE (7)"l","e","L","i","s" ; leLis
BYTE (7)"t"," ","f","i","e" ; t fie
BYTE (7)"l","d","-","t","y" ; ld-ty
BYTE (7)"p","e"," ","t","o" ; pe to
BYTE (7)" ","a","n","o","t" ; anot
BYTE (7)"h","e","r"," ","t" ; her t
BYTE (7)"y","p","e",000,000 ; ype
P.AGH: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","c","h","a" ; t cha
BYTE (7)"i","n"," ","a","n" ; in an
BYTE (7)"y"," ","o","t","h" ; y oth
BYTE (7)"e","r"," ","f","i" ; er fi
BYTE (7)"e","l","d","-","t" ; eld-t
BYTE (7)"y","p","e"," ","t" ; ype t
BYTE (7)"o"," ","F","i","l" ; o Fil
BYTE (7)"e","L","i","s","t" ; eList
BYTE (7)000,000,000,000,000
P.AGI: BYTE (7)"O","T","H","E","R" ; OTHER
BYTE (7)"W","I","S","E"," " ; WISE
BYTE (7)"m","e","a","n","i" ; meani
BYTE (7)"n","g","l","e","s" ; ngles
BYTE (7)"s"," ","h","e","r" ; s her
BYTE (7)"e",000,000,000,000 ; e
P.AGJ: BYTE (7)"G","a","r","b","a" ; Garba
BYTE (7)"g","e"," ","f","o" ; ge fo
BYTE (7)"l","l","o","w","i" ; llowi
BYTE (7)"n","g"," ","P","A" ; ng PA
BYTE (7)"R","S","E",000,000 ; RSE
CPPRSE: PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,3 ; SP,3
SETO AC1, ; AC1,
CAME AC1,CMDARG ; AC1,CMDARG
JRST L.324 ; L.324
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,CMDARG ; AC1,CMDARG
L.324: MOVEI AC1,25 ; AC1,25
SETZB AC2,AC3 ; AC2,AC3
SETZ AC4, ; AC4,
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC12,AC1 ; PRSINSTR,AC1
MOVEI AC1,30 ; AC1,30
SETZB AC2,AC3 ; AC2,AC3
SETZ AC4, ; AC4,
PUSHJ SP,GENINS ; SP,GENINS
SETOM -2(SP) ; FAILADDR
PUSHJ SP,SCAN ; SP,SCAN
MOVE AC11,AC12 ; AC11,PRSINSTR
ADDI AC11,2 ; AC11,2
MOVE AC1,SCACOD ; AC1,SCACOD
SETZ AC2, ; AC2,
CAIE AC1,16 ; AC1,16
JRST L.325 ; L.325
MOVEI AC2,1 ; AC2,1
JRST L.326 ; L.326
L.325: CAIE AC1,31 ; AC1,31
JRST L.342 ; L.342
L.326: TRNN AC2,1 ; AC2,1
JRST L.327 ; L.327
SETO AC10, ; PRNHAK,
JRST L.328 ; L.328
L.327: SETZ AC10, ; PRNHAK,
L.328: SETO AC13, ; LFDB,
SETZM -1(SP) ; FILOPT
PUSHJ SP,SCAN ; SP,SCAN
L.329: SETZ AC1, ; AC1,
MOVE AC2,AC11 ; AC2,AC11
PUSHJ SP,CPPRSI ; SP,CPPRSI
MOVE AC14,AC1 ; NFDB,AC1
JUMPGE AC14,L.330 ; NFDB,L.330
MOVNM AC14,-2(SP) ; NFDB,FAILADDR
MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
PUSHJ SP,SCAN ; SP,SCAN
JRST L.341 ; L.341
L.330: LDB AC1,C.34 ; AC1,[POINT 9,CNSWRK(AC14),8] <27,9>
CAIE AC1,6 ; AC1,6
JRST L.332 ; L.332
SKIPE -1(SP) ; FILOPT
JRST L.331 ; L.331
SETOM -1(SP) ; FILOPT
JRST L.332 ; L.332
L.331: MOVEI AC1,P.AGE ; AC1,P.AGE
PUSHJ SP,CERROR ; SP,CERROR
L.332: JUMPGE AC13,L.333 ; LFDB,L.333
MOVEM AC14,0(SP) ; NFDB,FDB
JRST L.337 ; L.337
L.333: LDB AC1,C.35 ; AC1,[POINT 9,CNSWRK(LFDB),8] <27,9>
CAIE AC1,2 ; AC1,2
JRST L.334 ; L.334
MOVEI AC1,P.AGF ; AC1,P.AGF
PUSHJ SP,CERROR ; SP,CERROR
L.334: LDB AC1,C.35 ; AC1,[POINT 9,CNSWRK(LFDB),8] <27,9>
CAIE AC1,27 ; AC1,27
JRST L.335 ; L.335
MOVEI AC1,P.AGG ; AC1,P.AGG
PUSHJ SP,CERROR ; SP,CERROR
L.335: LDB AC1,C.34 ; AC1,[POINT 9,CNSWRK(AC14),8] <27,9>
CAIE AC1,27 ; AC1,27
JRST L.336 ; L.336
MOVEI AC1,P.AGH ; AC1,P.AGH
PUSHJ SP,CERROR ; SP,CERROR
L.336: HRRM AC14,CNSWRK(AC13) ; NFDB,CNSWRK(LFDB)
L.337: MOVE AC13,AC14 ; LFDB,NFDB
MOVE AC1,SCACOD ; AC1,SCACOD
CAIE AC1,20 ; AC1,20
CAIN AC1,17 ; AC1,17
JRST L.338 ; L.338
CAIN AC1,32 ; AC1,32
JRST L.338 ; L.338
MOVEI AC1,CERM14 ; AC1,CERM14
PUSHJ SP,CERROR ; SP,CERROR
L.338: MOVEI AC1,20 ; AC1,20
CAMN AC1,SCACOD ; AC1,SCACOD
PUSHJ SP,SCAN ; SP,SCAN
JUMPE AC10,L.339 ; PRNHAK,L.339
MOVEI AC1,32 ; AC1,32
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.339 ; L.339
MOVEI AC1,CERM14 ; AC1,CERM14
PUSHJ SP,CERROR ; SP,CERROR
L.339: JUMPN AC10,L.340 ; PRNHAK,L.340
MOVEI AC1,17 ; AC1,17
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.340 ; L.340
MOVEI AC1,CERM7 ; AC1,CERM7
PUSHJ SP,CERROR ; SP,CERROR
L.340: MOVE AC1,SCACOD ; AC1,SCACOD
CAIN AC1,17 ; AC1,17
JRST L.341 ; L.341
CAIE AC1,32 ; AC1,32
JRST L.329 ; L.329
L.341: PUSHJ SP,SCAN ; SP,SCAN
JRST L.344 ; L.344
L.342: SETZ AC1, ; AC1,
MOVE AC2,AC11 ; AC2,AC11
PUSHJ SP,CPPRSI ; SP,CPPRSI
MOVEM AC1,0(SP) ; AC1,FDB
SKIPL 0(SP) ; FDB
JRST L.343 ; L.343
MOVEI AC1,P.AGI ; AC1,P.AGI
PUSHJ SP,CERROR ; SP,CERROR
L.343: MOVE AC1,SCACOD ; AC1,SCACOD
CAIE AC1,20 ; AC1,20
CAIN AC1,32 ; AC1,32
JRST L.344 ; L.344
CAIE AC1,17 ; AC1,17
CAIN AC1,41 ; AC1,41
JRST L.344 ; L.344
MOVEI AC1,P.AGJ ; AC1,P.AGJ
PUSHJ SP,CERROR ; SP,CERROR
L.344: MOVE AC1,0(SP) ; AC1,FDB
HRRM AC1,CODWRK(AC12) ; AC1,CODWRK(PRSINSTR)
MOVE AC1,-2(SP) ; AC1,FAILADDR
HRRM AC1,CODWRK+1(AC12) ; AC1,CODWRK+1(PRSINSTR)
MOVE AC1,NEXTIN ; AC1,NEXTIN
HRRM AC1,CODWRK(AC11) ; AC1,CODWRK(AC11)
ADJSP SP,-3 ; SP,-3
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
C.35: POINT 9,CNSWRK(AC13),8 ; 9,CNSWRK(LFDB),8
; Routine Size: 140 words
; 2652
; 2653 ROUTINE CPPRSI(FLG,DONEAD) = ! <Parse-item>
; 2654
; 2655 !++
; 2656 ! Functional description:
; 2657 ! Compiles one item of a Parse list, whether for Command arguments
; 2658 ! or for a Parse statement. I build an FLDDB in the constants,
; 2659 ! containing everything necessary for COMND% but in position-
; 2660 ! independent form. If compiling a Parse, I compile any success-
; 2661 ! statement and set the .CMBRK word to it; if none is requested
; 2662 ! I set .CMBRK to the done-address passed by my caller. If compiling
; 2663 ! Command arguments, I declare any destination-variable and put its
; 2664 ! symbol index in .CMBRK<LH>, or -1 if none is desired.
; 2665 ! In the Parse case, there is a complication: An OTHERWISE Parse-type
; 2666 ! does not result in an FLDDB, but only the compilation of its
; 2667 ! success-statement; in this case I return the negative of the address
; 2668 ! of the code compiled.
; 2669 !
; 2670 ! Formal parameters:
; 2671 ! Flag: 0=Parse, 1=Command arguments
; 2672 ! Location to jump to after completion of success-statement (Parse)
; 2673 !
; 2674 ! Implicit inputs:
; 2675 ! Source
; 2676 !
; 2677 ! Implicit outputs:
; 2678 ! Code, constants
; 2679 !
; 2680 ! Routine value:
; 2681 ! Constants index of FLDDB, or negative of jump address if
; 2682 ! OTHERWISE requested
; 2683 !
; 2684 ! Side effects:
; 2685 ! Scans from Parse-type to unrecognized atom
; 2686 !
; 2687 !--
; 2688
; 2689 BEGIN
; 2690 EXTERNAL REGISTER Z=0;
; 2691 LOCAL
; 2692 FDB, ! Index of FLDDB being constructed
; 2693 FNC; ! Function code
; 2694 %( This should be built symbolically )%
; 2695 BIND
; 2696 TYPTBL = UPLIT(%B'000011110110001111100111000000000000');
; 2697 IF .FLG EQL 0
; 2698 THEN
; 2699 IF .SCACOD EQL SCN_OTHERWISE
; 2700 THEN
; 2701 BEGIN
; 2702 IF SCAN() NEQ SCN_COLON THEN CERROR(CERM11);
; 2703 SCAN();
; 2704 FDB = -.NEXTIN;
; 2705 IF CPSTMT() EQL FALSE THEN CERROR(CERM12);
; 2706 RETURN .FDB
; 2707 END;
; 2708 ! Identify the field type
; 2709 IF .SCACOD NEQ SCN_IDENT THEN CERROR(CERM2);
; 2710 FNC =
; 2711 (DECR I FROM FNMCNT-1 DO
; 2712 IF .SCALEN EQL .FNMTBL[.I,RSNLEN] THEN
; 2713 IF CH$EQL( .SCALEN, CH$PTR(SCATOM),
; 2714 .SCALEN, BYTPTR(.FNMTBL[.I,RSNSTR]))
; 2715 THEN
; 2716 EXITLOOP .I);
; 2717 IF .FNC LSS 0 THEN CERROR(CERM2);
; 2718 FNC = .FNMTBL[.FNC,RSNSCN];
; 2719 IF .FLG NEQ 0
; 2720 THEN
; 2721 IF .FNC EQL $CMCFM THEN ERROR('EOL parse-type invalid');
; 2722 ! Allocate the FLDDB
; 2723 FDB = .CONSTP;
; 2724 CONSTP = .CONSTP + $CMBRK + 1;
; 2725 IF .CONSTP GEQ CNSWKL THEN CERROR(CERM1);
; 2726 CNSWRK[.FDB+$CMFNP] = 0;
; 2727 CNSWRK[.FDB+$CMDAT] = 0;
; 2728 CNSWRK[.FDB+$CMHLP] = 0;
; 2729 CNSWRK[.FDB+$CMDEF] = 0;
; 2730 IF .FLG EQL 0
; 2731 THEN
; 2732 CNSWRK[.FDB+$CMBRK] = .DONEAD
; 2733 ELSE
; 2734 CNSWRK[.FDB+$CMBRK] = -1;
; 2735 POINTR((CNSWRK[.FDB+$CMFNP]),CM_FNC) = .FNC;
; 2736 IF .FNC EQL $CMTOK OR .FNC EQL $CMNOI
; 2737 THEN
; 2738 BEGIN
; 2739 IF SCAN() NEQ SCN_QSTRING THEN CERROR(CERM19);
; 2740 CNSWRK[.FDB+$CMDAT] = CPSPRM()
; 2741 END
; 2742 ELSE
; 2743 SCAN();
; 2744 ! Process options
; 2745 IF .SCACOD EQL SCN_LPAREN THEN CPPRSO(.FNC,.FDB,.FLG);
; 2746 ! Do some defaulting
; 2747 SELECTONE .FNC OF
; 2748 SET
; 2749 [$CMKEY,
; 2750 $CMSWI]: IF .CNSWRK[.FDB+$CMDAT] EQL 0 THEN ERROR('Must provide word list');
; 2751 [$CMNUM]: IF .CNSWRK[.FDB+$CMDAT] EQL 0 THEN CNSWRK[.FDB+$CMDAT] = 10;
; 2752 [$CMTAD]: IF .CNSWRK[.FDB+$CMDAT] EQL 0
; 2753 THEN
; 2754 CNSWRK[.FDB+$CMDAT] = CM_IDA + CM_ITM;
; 2755 [$CMFLS]: CPPRSF(.FDB,-1,GJ_IFG)
; 2756 TES;
; 2757 IF .SCACOD EQL SCN_COLON
; 2758 THEN
; 2759 IF .FLG EQL 0
; 2760 THEN
; 2761 BEGIN
; 2762 ! Compile success-statement
; 2763 SCAN();
; 2764 CNSWRK[.FDB+$CMBRK] = .NEXTIN;
; 2765 IF CPSTMT() EQL FALSE THEN CERROR(CERM9);
; 2766 GENINS(OPR_JMP,.DONEAD,0,0)
; 2767 END
; 2768 ELSE
; 2769 BEGIN
; 2770 ! Define destination identifier
; 2771 LOCAL
; 2772 HLFTMP: HLF_WRD,
; 2773 STE; ! Symbol table index
; 2774 IF SCAN() NEQ SCN_IDENT THEN CERROR(CERM3);
; 2775 STE = ADDSMB();
; 2776 IF .STE LSS 0 THEN CERROR(CERM4);
; 2777 IF .NUMVRS GEQ MAXVRC THEN CERROR(CERM15);
; 2778 SYMWRK[.STE,STE_CLS] = STE_CLS_VAR;
; 2779 SYMWRK[.STE,STE_LOC] = .NUMVRS + FRM_LOC;
; 2780 NUMVRS = .NUMVRS + 1;
; 2781 SYMWRK[.STE,STE_TYP] = CH$RCHAR(CH$PTR(TYPTBL,.FNC,1));
; 2782 HLFTMP = .CNSWRK[.FDB+$CMBRK];
; 2783 HLFTMP[HLF_LFT] = .STE;
; 2784 CNSWRK[.FDB+$CMBRK] = .HLFTMP;
; 2785 SCAN()
; 2786 END;
; 2787 .FDB
; 2788 END;
P.AGK: EXP 36617470000
P.AGL: BYTE (7)"E","O","L"," ","p" ; EOL p
BYTE (7)"a","r","s","e","-" ; arse-
BYTE (7)"t","y","p","e"," " ; type
BYTE (7)"i","n","v","a","l" ; inval
BYTE (7)"i","d",000,000,000 ; id
P.AGM: BYTE (7)"M","u","s","t"," " ; Must
BYTE (7)"p","r","o","v","i" ; provi
BYTE (7)"d","e"," ","w","o" ; de wo
BYTE (7)"r","d"," ","l","i" ; rd li
BYTE (7)"s","t",000,000,000 ; st
TYPTBL= P.AGK
CPPRSI: PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,1 ; SP,1
MOVE AC10,AC2 ; DONEAD,AC2
MOVE AC11,AC1 ; FLG,AC1
SETZM 0(SP) ; 0(SP)
JUMPN AC11,L.346 ; FLG,L.346
MOVEI AC1,1 ; AC1,1
MOVEM AC1,0(SP) ; AC1,0(SP)
MOVEI AC1,62 ; AC1,62
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.346 ; L.346
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,22 ; AC1,22
JRST L.345 ; L.345
MOVEI AC1,CERM11 ; AC1,CERM11
PUSHJ SP,CERROR ; SP,CERROR
L.345: PUSHJ SP,SCAN ; SP,SCAN
MOVN AC14,NEXTIN ; FDB,NEXTIN
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.372 ; AC1,L.372
MOVEI AC1,CERM12 ; AC1,CERM12
PUSHJ SP,CERROR ; SP,CERROR
JRST L.372 ; L.372
L.346: MOVEI AC1,1 ; AC1,1
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.347 ; L.347
MOVEI AC1,CERM2 ; AC1,CERM2
PUSHJ SP,CERROR ; SP,CERROR
L.347: MOVEI AC3,22 ; I,22
L.348: LDB AC1,C.36 ; AC1,[POINT 9,FNMTBL(I),17] <18,9>
CAME AC1,SCALEN ; AC1,SCALEN
JRST L.349 ; L.349
HRRZ AC5,FNMTBL(AC3) ; HLF,FNMTBL(I)
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,SCALEN ; AC1,SCALEN
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
MOVE AC4,SCALEN ; AC4,SCALEN
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.349 ; L.349
MOVE AC13,AC3 ; FNC,I
JRST L.350 ; L.350
L.349: SOJGE AC3,L.348 ; I,L.348
SETO AC13, ; FNC,
L.350: JUMPGE AC13,L.351 ; FNC,L.351
MOVEI AC1,CERM2 ; AC1,CERM2
PUSHJ SP,CERROR ; SP,CERROR
L.351: LDB AC13,C.37 ; FNC,[POINT 9,FNMTBL(FNC),8] <27,9>
JUMPE AC11,L.352 ; FLG,L.352
CAIE AC13,10 ; FNC,10
JRST L.352 ; L.352
MOVEI AC1,P.AGL ; AC1,P.AGL
PUSHJ SP,CERROR ; SP,CERROR
L.352: MOVE AC14,CONSTP ; FDB,CONSTP
MOVEI AC1,5 ; AC1,5
ADDM AC1,CONSTP ; AC1,CONSTP
MOVEI AC1,6000 ; AC1,6000
CAMLE AC1,CONSTP ; AC1,CONSTP
JRST L.353 ; L.353
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.353: SETZM CNSWRK(AC14) ; CNSWRK(FDB)
SETZM CNSWRK+1(AC14) ; CNSWRK+1(FDB)
SETZM CNSWRK+2(AC14) ; CNSWRK+2(FDB)
SETZM CNSWRK+3(AC14) ; CNSWRK+3(FDB)
MOVE AC2,AC14 ; AC2,FDB
ADD AC2,C.9 ; AC2,[CNSWRK]
MOVE AC12,AC2 ; AC12,AC2
ADDI AC12,4 ; AC12,4
MOVEI AC1,1 ; AC1,1
TDNN AC1,0(SP) ; AC1,0(SP)
JRST L.354 ; L.354
MOVEM AC10,0(AC12) ; DONEAD,0(AC12)
JRST L.355 ; L.355
L.354: SETOM 0(AC12) ; 0(AC12)
L.355: DPB AC13,C.34 ; FNC,[POINT 9,CNSWRK(AC14),8] <27,9>
CAIN AC13,23 ; FNC,23
JRST L.356 ; L.356
CAIE AC13,2 ; FNC,2
JRST L.358 ; L.358
L.356: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,3 ; AC1,3
JRST L.357 ; L.357
MOVEI AC1,CERM19 ; AC1,CERM19
PUSHJ SP,CERROR ; SP,CERROR
L.357: PUSHJ SP,CPSPRM ; SP,CPSPRM
MOVEM AC1,CNSWRK+1(AC14) ; AC1,CNSWRK+1(FDB)
JRST L.359 ; L.359
L.358: PUSHJ SP,SCAN ; SP,SCAN
L.359: MOVEI AC1,16 ; AC1,16
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.360 ; L.360
MOVE AC1,AC13 ; AC1,FNC
MOVE AC2,AC14 ; AC2,FDB
MOVE AC3,AC11 ; AC3,FLG
PUSHJ SP,CPPRSO ; SP,CPPRSO
L.360: JUMPE AC13,L.361 ; FNC,L.361
CAIE AC13,3 ; FNC,3
JRST L.362 ; L.362
L.361: SKIPE CNSWRK+1(AC14) ; CNSWRK+1(FDB)
JRST L.366 ; L.366
MOVEI AC1,P.AGM ; AC1,P.AGM
PUSHJ SP,CERROR ; SP,CERROR
JRST L.366 ; L.366
L.362: CAIE AC13,1 ; FNC,1
JRST L.363 ; L.363
SKIPE CNSWRK+1(AC14) ; CNSWRK+1(FDB)
JRST L.366 ; L.366
MOVEI AC1,12 ; AC1,12
JRST L.364 ; L.364
L.363: CAIE AC13,20 ; FNC,20
JRST L.365 ; L.365
SKIPE CNSWRK+1(AC14) ; CNSWRK+1(FDB)
JRST L.366 ; L.366
MOVSI AC1,-200000 ; AC1,-200000
L.364: MOVEM AC1,CNSWRK+1(AC14) ; AC1,CNSWRK+1(FDB)
JRST L.366 ; L.366
L.365: CAIE AC13,27 ; FNC,27
JRST L.366 ; L.366
MOVE AC1,AC14 ; AC1,FDB
SETO AC2, ; AC2,
MOVSI AC3,100 ; AC3,100
PUSHJ SP,CPPRSF ; SP,CPPRSF
L.366: MOVEI AC1,22 ; AC1,22
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.372 ; L.372
MOVEI AC1,1 ; AC1,1
TDNN AC1,0(SP) ; AC1,0(SP)
JRST L.368 ; L.368
PUSHJ SP,SCAN ; SP,SCAN
MOVE AC1,NEXTIN ; AC1,NEXTIN
MOVEM AC1,0(AC12) ; AC1,0(AC12)
PUSHJ SP,CPSTMT ; SP,CPSTMT
JUMPN AC1,L.367 ; AC1,L.367
MOVEI AC1,CERM9 ; AC1,CERM9
PUSHJ SP,CERROR ; SP,CERROR
L.367: MOVEI AC1,30 ; AC1,30
MOVE AC2,AC10 ; AC2,DONEAD
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
JRST L.372 ; L.372
L.368: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.369 ; L.369
MOVEI AC1,CERM3 ; AC1,CERM3
PUSHJ SP,CERROR ; SP,CERROR
L.369: PUSHJ SP,ADDSMB ; SP,ADDSMB
MOVE AC11,AC1 ; STE,AC1
JUMPGE AC11,L.370 ; STE,L.370
MOVEI AC1,CERM4 ; AC1,CERM4
PUSHJ SP,CERROR ; SP,CERROR
L.370: MOVEI AC1,200 ; AC1,200
CAMLE AC1,NUMVRS ; AC1,NUMVRS
JRST L.371 ; L.371
MOVEI AC1,CERM15 ; AC1,CERM15
PUSHJ SP,CERROR ; SP,CERROR
L.371: MOVE AC1,AC11 ; AC1,STE
IMULI AC1,2 ; AC1,2
MOVSI AC2,70000 ; AC2,70000
ANDCAM AC2,SYMWRK(AC1) ; AC2,SYMWRK(AC1)
MOVE AC2,NUMVRS ; AC2,NUMVRS
ADDI AC2,2 ; AC2,2
HRRM AC2,SYMWRK(AC1) ; AC2,SYMWRK(AC1)
AOS NUMVRS ; NUMVRS
MOVE AC3,C.38 ; AC3,[POINT 1,TYPTBL,-1] <36,1>
MOVE AC2,AC13 ; AC2,FNC
ADJBP AC2,AC3 ; AC2,AC3
ILDB AC2,AC2 ; AC2,AC2
DPB AC2,C.28 ; AC2,[POINT 1,SYMWRK(AC1),6] <29,1>
MOVE AC1,0(AC12) ; HLFTMP,0(AC12)
HRL AC1,AC11 ; HLFTMP,STE
MOVEM AC1,0(AC12) ; HLFTMP,0(AC12)
PUSHJ SP,SCAN ; SP,SCAN
L.372: MOVE AC1,AC14 ; AC1,FDB
ADJSP SP,-1 ; SP,-1
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
C.36: POINT 9,FNMTBL(AC3),17 ; 9,FNMTBL(I),17
C.37: POINT 9,FNMTBL(AC13),8 ; 9,FNMTBL(FNC),8
C.38: POINT 1,TYPTBL,-1 ; 1,TYPTBL,-1
; Routine Size: 187 words
; 2789
; 2790 ROUTINE CPPRSO(FNC,FDB,FLG): NOVALUE = ! <Parse-options>
; 2791
; 2792 !++
; 2793 ! Functional description:
; 2794 ! Compile Parse options.
; 2795 !
; 2796 ! Formal parameters:
; 2797 ! Function code of field being described
; 2798 ! Constant index of FLDDB being constructed
; 2799 ! 0 if compiling PARSE, 1 if compiling Command arguments
; 2800 !
; 2801 ! Implicit inputs:
; 2802 ! Source
; 2803 !
; 2804 ! Implicit outputs:
; 2805 ! Constants
; 2806 !
; 2807 ! Routine value:
; 2808 ! None
; 2809 !
; 2810 ! Side effects:
; 2811 ! Scans from ( to unrecognized atom
; 2812 !
; 2813 !--
; 2814
; 2815 BEGIN
; 2816 EXTERNAL REGISTER Z=0;
; 2817 DO
; 2818 BEGIN
; 2819 SELECTONE SCAN() OF
; 2820 SET
; 2821 [SCN_NOINDIRECT]:
; 2822 BEGIN
; 2823 SCAN();
; 2824 POINTR((CNSWRK[.FDB+$CMFNP]),CM_NIN) = 1
; 2825 END;
; 2826 [SCN_DEFAULT]: BEGIN
; 2827 SCAN();
; 2828 CNSWRK[.FDB+$CMDEF] = CPSPRM();
; 2829 POINTR((CNSWRK[.FDB+$CMFNP]),CM_DPP) = 1
; 2830 END;
; 2831 [SCN_HELP]: BEGIN
; 2832 SCAN();
; 2833 CNSWRK[.FDB+$CMHLP] = CPSPRM();
; 2834 POINTR((CNSWRK[.FDB+$CMFNP]),CM_HPP) = 1;
; 2835 IF .POINTR((CNSWRK[.FDB+$CMFNP]),CM_SHR) EQL 0
; 2836 THEN
; 2837 POINTR((CNSWRK[.FDB+$CMFNP]),CM_SDH) = 1
; 2838 END;
; 2839 [SCN_NOHELP]: BEGIN
; 2840 SCAN();
; 2841 POINTR((CNSWRK[.FDB+$CMFNP]),CM_SDH) = 1
; 2842 END;
; 2843 [SCN_WORDS]: CNSWRK[.FDB+$CMDAT] = CPPRSW(.FNC);
; 2844 [SCN_RADIX]: BEGIN
; 2845 IF .FNC NEQ $CMNUM THEN ERROR('RADIX only for CMNUM fields');
; 2846 IF SCAN() NEQ SCN_NUMB THEN ERROR('Radix missing');
; 2847 IF .SCANUM LSS 2 OR .SCANUM GTR 10 THEN ERROR('Illegal radix');
; 2848 CNSWRK[.FDB+$CMDAT] = .SCANUM;
; 2849 SCAN()
; 2850 END;
; 2851 [SCN_PARSEONLY]:BEGIN
; 2852 SELECTONE .FNC OF
; 2853 SET
; 2854 [$CMFIL]: CPPRSF(.FDB,-1,GJ_OFG);
; 2855 [$CMDEV,
; 2856 $CMNOD,
; 2857 $CMDIR,
; 2858 $CMUSR]: POINTR((CNSWRK[.FDB+$CMFNP]),CM_PO) = 1;
; 2859 [OTHERWISE]:ERROR('PARSEONLY meaningless for this field type')
; 2860 TES;
; 2861 SCAN()
; 2862 END;
; 2863 [SCN_STDHELP]: BEGIN
; 2864 POINTR((CNSWRK[.FDB+$CMFNP]),CM_SDH) = 0;
; 2865 POINTR((CNSWRK[.FDB+$CMFNP]),CM_SHR) = 1;
; 2866 SCAN()
; 2867 END;
; 2868 [SCN_TIME]: BEGIN
; 2869 POINTR((CNSWRK[.FDB+$CMDAT]),CM_ITM) = 1;
; 2870 SCAN()
; 2871 END;
; 2872 [SCN_DATE]: BEGIN
; 2873 POINTR((CNSWRK[.FDB+$CMDAT]),CM_IDA) = 1;
; 2874 SCAN()
; 2875 END;
; 2876 [SCN_INPUT]: BEGIN
; 2877 IF .FNC NEQ $CMFIL AND .FNC NEQ $CMFLS
; 2878 THEN
; 2879 ERROR('INPUT only for FILE or FILELIST fields');
; 2880 CPPRSF(.FDB,-1,GJ_OLD);
; 2881 SCAN()
; 2882 END;
; 2883 [SCN_OUTPUT]: BEGIN
; 2884 IF .FNC NEQ $CMFIL AND .FNC NEQ $CMFLS
; 2885 THEN
; 2886 ERROR('OUTPUT only for FILE or FILELIST fields');
; 2887 CPPRSF(.FDB,-1,GJ_FOU);
; 2888 SCAN()
; 2889 END;
; 2890 [SCN_WILD]: BEGIN
; 2891 IF .FNC NEQ $CMFIL AND .FNC NEQ $CMFLS
; 2892 THEN
; 2893 ERROR('WILD only for FILE and FILELIST fields');
; 2894 POINTR((CNSWRK[.FDB+$CMFNP]),CM_WLD) = 1;
; 2895 CPPRSF(.FDB,-1,GJ_IFG);
; 2896 SCAN()
; 2897 END;
; 2898 [SCN_INVISIBLE]:BEGIN
; 2899 IF .FNC NEQ $CMFIL AND .FNC NEQ $CMFLS
; 2900 THEN
; 2901 ERROR('INVISIBLE only for FILE and FILELIST fields');
; 2902 CPPRSF(.FDB,-2,G1_IIN);
; 2903 SCAN()
; 2904 END;
; 2905 [SCN_DELETED]: BEGIN
; 2906 IF .FNC NEQ $CMFIL AND .FNC NEQ $CMFLS
; 2907 THEN
; 2908 ERROR('DELETED only for FILE and FILELIST fields');
; 2909 CPPRSF(.FDB,-1,GJ_DEL);
; 2910 SCAN()
; 2911 END;
; 2912 [SCN_DEFAULT_DEV,
; 2913 SCN_DEFAULT_DIR,
; 2914 SCN_DEFAULT_NAM,
; 2915 SCN_DEFAULT_EXT]: BEGIN
; 2916 LOCAL
; 2917 COD, ! Scan code
; 2918 STR; ! String location
; 2919 BIND DEF_LST = UPLIT($GJDEV,$GJDIR,$GJNAM,$GJEXT): VECTOR;
; 2920 IF .FNC NEQ $CMFIL AND .FNC NEQ $CMFLS
; 2921 THEN
; 2922 ERROR('Only for FILE and FILELIST fields');
; 2923 COD = .DEF_LST[.SCACOD-SCN_DEFAULT_DEV];
; 2924 SCAN();
; 2925 STR = CPSPRM();
; 2926 CPPRSF(.FDB,.COD,.STR)
; 2927 END;
; 2928 [SCN_DEFAULT_GEN]: BEGIN
; 2929 LOCAL
; 2930 CODE;
; 2931 IF .FNC NEQ $CMFIL AND .FNC NEQ $CMFLS
; 2932 THEN
; 2933 ERROR('Only for FILE and FILELIST fields');
; 2934 SELECTONE SCAN() OF
; 2935 SET
; 2936 [SCN_NUMB]: CODE = .SCANUM;
; 2937 [SCN_PLUS]: CODE = $GJNHG;
; 2938 [SCN_MINUS]: CODE = $GJLEG;
; 2939 [SCN_TIMES]: CODE = $GJALL;
; 2940 [OTHERWISE]: ERROR('Invalid code')
; 2941 TES;
; 2942 CPPRSF(.FDB,$GJGEN,.CODE);
; 2943 SCAN()
; 2944 END;
; 2945 [SCN_ERROR]: IF .FLG EQL 0
; 2946 THEN
; 2947 ERROR('ERROR not permitted here')
; 2948 ELSE
; 2949 BEGIN
; 2950 LOCAL
; 2951 HLFTMP: HLF_WRD,
; 2952 PTR;
; 2953 IF SCAN() NEQ SCN_IDENT THEN CERROR(CERM3);
; 2954 PTR =
; 2955 (DECR I FROM .LBLCNT-1 DO
; 2956 IF CH$EQL( .SCALEN+1,BYTPTR(SCATOM),
; 2957 .SCALEN+1,.LBLNAM[.I])
; 2958 THEN
; 2959 EXITLOOP .I);
; 2960 IF .PTR LSS 0
; 2961 THEN
; 2962 BEGIN
; 2963 IF .LBLCNT GEQ MAXLBL THEN CERROR(CERM10);
; 2964 LBLNAM[.LBLCNT] = BYTPTR(PCMGMM((.SCALEN+5)/5, DICT));
; 2965 CH$MOVE(.SCALEN+1, BYTPTR(SCATOM), .LBLNAM[.LBLCNT]);
; 2966 LBLADR[.LBLCNT] = - ((2^17) + .FDB + $CMBRK);
; 2967 LBLCNT = .LBLCNT + 1;
; 2968 PTR = 0
; 2969 END
; 2970 ELSE
; 2971 IF .LBLADR[.PTR] LSS 0
; 2972 THEN
; 2973 BEGIN
; 2974 LOCAL
; 2975 EPTR;
; 2976 EPTR = -.LBLADR[.PTR];
; 2977 LBLADR[.PTR] = - ((2^17) + .FDB + $CMBRK);
; 2978 PTR = .EPTR
; 2979 END
; 2980 ELSE
; 2981 PTR = .LBLADR[.PTR];
; 2982 HLFTMP = .CNSWRK[.FDB+$CMBRK];
; 2983 HLFTMP[HLF_RGT] = .PTR;
; 2984 CNSWRK[.FDB+$CMBRK] = .HLFTMP;
; 2985 SCAN()
; 2986 END;
; 2987 [OTHERWISE]: ERROR('Parse option not found where required')
; 2988 TES
; 2989 END
; 2990 UNTIL
; 2991 .SCACOD NEQ SCN_COMMA;
; 2992 POINTR((CNSWRK[.FDB+$CMFNP]),CM_SHR) = 0;
; 2993 IF .SCACOD NEQ SCN_RPAREN
; 2994 THEN
; 2995 ERROR('Garbage found after parse option');
; 2996 SCAN()
; 2997 END;
P.AGN: BYTE (7)"R","A","D","I","X" ; RADIX
BYTE (7)" ","o","n","l","y" ; only
BYTE (7)" ","f","o","r"," " ; for
BYTE (7)"C","M","N","U","M" ; CMNUM
BYTE (7)" ","f","i","e","l" ; fiel
BYTE (7)"d","s",000,000,000 ; ds
P.AGO: BYTE (7)"R","a","d","i","x" ; Radix
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
P.AGP: BYTE (7)"I","l","l","e","g" ; Illeg
BYTE (7)"a","l"," ","r","a" ; al ra
BYTE (7)"d","i","x",000,000 ; dix
P.AGQ: BYTE (7)"P","A","R","S","E" ; PARSE
BYTE (7)"O","N","L","Y"," " ; ONLY
BYTE (7)"m","e","a","n","i" ; meani
BYTE (7)"n","g","l","e","s" ; ngles
BYTE (7)"s"," ","f","o","r" ; s for
BYTE (7)" ","t","h","i","s" ; this
BYTE (7)" ","f","i","e","l" ; fiel
BYTE (7)"d"," ","t","y","p" ; d typ
BYTE (7)"e",000,000,000,000 ; e
P.AGR: BYTE (7)"I","N","P","U","T" ; INPUT
BYTE (7)" ","o","n","l","y" ; only
BYTE (7)" ","f","o","r"," " ; for
BYTE (7)"F","I","L","E"," " ; FILE
BYTE (7)"o","r"," ","F","I" ; or FI
BYTE (7)"L","E","L","I","S" ; LELIS
BYTE (7)"T"," ","f","i","e" ; T fie
BYTE (7)"l","d","s",000,000 ; lds
P.AGS: BYTE (7)"O","U","T","P","U" ; OUTPU
BYTE (7)"T"," ","o","n","l" ; T onl
BYTE (7)"y"," ","f","o","r" ; y for
BYTE (7)" ","F","I","L","E" ; FILE
BYTE (7)" ","o","r"," ","F" ; or F
BYTE (7)"I","L","E","L","I" ; ILELI
BYTE (7)"S","T"," ","f","i" ; ST fi
BYTE (7)"e","l","d","s",000 ; elds
P.AGT: BYTE (7)"W","I","L","D"," " ; WILD
BYTE (7)"o","n","l","y"," " ; only
BYTE (7)"f","o","r"," ","F" ; for F
BYTE (7)"I","L","E"," ","a" ; ILE a
BYTE (7)"n","d"," ","F","I" ; nd FI
BYTE (7)"L","E","L","I","S" ; LELIS
BYTE (7)"T"," ","f","i","e" ; T fie
BYTE (7)"l","d","s",000,000 ; lds
P.AGU: BYTE (7)"I","N","V","I","S" ; INVIS
BYTE (7)"I","B","L","E"," " ; IBLE
BYTE (7)"o","n","l","y"," " ; only
BYTE (7)"f","o","r"," ","F" ; for F
BYTE (7)"I","L","E"," ","a" ; ILE a
BYTE (7)"n","d"," ","F","I" ; nd FI
BYTE (7)"L","E","L","I","S" ; LELIS
BYTE (7)"T"," ","f","i","e" ; T fie
BYTE (7)"l","d","s",000,000 ; lds
P.AGV: BYTE (7)"D","E","L","E","T" ; DELET
BYTE (7)"E","D"," ","o","n" ; ED on
BYTE (7)"l","y"," ","f","o" ; ly fo
BYTE (7)"r"," ","F","I","L" ; r FIL
BYTE (7)"E"," ","a","n","d" ; E and
BYTE (7)" ","F","I","L","E" ; FILE
BYTE (7)"L","I","S","T"," " ; LIST
BYTE (7)"f","i","e","l","d" ; field
BYTE (7)"s",000,000,000,000 ; s
P.AGW: EXP 2
EXP 3
EXP 4
EXP 5
P.AGX: BYTE (7)"O","n","l","y"," " ; Only
BYTE (7)"f","o","r"," ","F" ; for F
BYTE (7)"I","L","E"," ","a" ; ILE a
BYTE (7)"n","d"," ","F","I" ; nd FI
BYTE (7)"L","E","L","I","S" ; LELIS
BYTE (7)"T"," ","f","i","e" ; T fie
BYTE (7)"l","d","s",000,000 ; lds
P.AGY: BYTE (7)"O","n","l","y"," " ; Only
BYTE (7)"f","o","r"," ","F" ; for F
BYTE (7)"I","L","E"," ","a" ; ILE a
BYTE (7)"n","d"," ","F","I" ; nd FI
BYTE (7)"L","E","L","I","S" ; LELIS
BYTE (7)"T"," ","f","i","e" ; T fie
BYTE (7)"l","d","s",000,000 ; lds
P.AGZ: BYTE (7)"I","n","v","a","l" ; Inval
BYTE (7)"i","d"," ","c","o" ; id co
BYTE (7)"d","e",000,000,000 ; de
P.AHA: BYTE (7)"E","R","R","O","R" ; ERROR
BYTE (7)" ","n","o","t"," " ; not
BYTE (7)"p","e","r","m","i" ; permi
BYTE (7)"t","t","e","d"," " ; tted
BYTE (7)"h","e","r","e",000 ; here
P.AHB: BYTE (7)"P","a","r","s","e" ; Parse
BYTE (7)" ","o","p","t","i" ; opti
BYTE (7)"o","n"," ","n","o" ; on no
BYTE (7)"t"," ","f","o","u" ; t fou
BYTE (7)"n","d"," ","w","h" ; nd wh
BYTE (7)"e","r","e"," ","r" ; ere r
BYTE (7)"e","q","u","i","r" ; equir
BYTE (7)"e","d",000,000,000 ; ed
P.AHC: BYTE (7)"G","a","r","b","a" ; Garba
BYTE (7)"g","e"," ","f","o" ; ge fo
BYTE (7)"u","n","d"," ","a" ; und a
BYTE (7)"f","t","e","r"," " ; fter
BYTE (7)"p","a","r","s","e" ; parse
BYTE (7)" ","o","p","t","i" ; opti
BYTE (7)"o","n",000,000,000 ; on
DEF_LST= P.AGW
CPPRSO: PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC10,AC3 ; FLG,AC3
MOVE AC14,AC2 ; FDB,AC2
MOVE AC11,AC1 ; FNC,AC1
L.373: PUSHJ SP,SCAN ; SP,SCAN
MOVE AC13,AC1 ; AC13,AC1
CAIE AC13,63 ; AC13,63
JRST L.374 ; L.374
PUSHJ SP,SCAN ; SP,SCAN
MOVSI AC1,400 ; AC1,400
JRST L.378 ; L.378
L.374: CAIE AC13,64 ; AC13,64
JRST L.375 ; L.375
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSPRM ; SP,CPSPRM
MOVEM AC1,CNSWRK+3(AC14) ; AC1,CNSWRK+3(FDB)
MOVSI AC1,2 ; AC1,2
JRST L.378 ; L.378
L.375: CAIE AC13,65 ; AC13,65
JRST L.376 ; L.376
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSPRM ; SP,CPSPRM
MOVEM AC1,CNSWRK+2(AC14) ; AC1,CNSWRK+2(FDB)
MOVSI AC1,4 ; AC1,4
IORM AC1,CNSWRK(AC14) ; AC1,CNSWRK(FDB)
LDB AC1,C.39 ; AC1,[POINT 1,CNSWRK(FDB),10] <25,1>
JUMPN AC1,L.428 ; AC1,L.428
JRST L.377 ; L.377
L.376: CAIE AC13,66 ; AC13,66
JRST L.379 ; L.379
PUSHJ SP,SCAN ; SP,SCAN
L.377: MOVSI AC1,1 ; AC1,1
L.378: IORM AC1,CNSWRK(AC14) ; AC1,CNSWRK(FDB)
JRST L.428 ; L.428
L.379: CAIE AC13,67 ; AC13,67
JRST L.380 ; L.380
MOVE AC1,AC11 ; AC1,FNC
PUSHJ SP,CPPRSW ; SP,CPPRSW
MOVEM AC1,CNSWRK+1(AC14) ; AC1,CNSWRK+1(FDB)
JRST L.428 ; L.428
L.380: CAIE AC13,70 ; AC13,70
JRST L.385 ; L.385
CAIN AC11,1 ; FNC,1
JRST L.381 ; L.381
MOVEI AC1,P.AGN ; AC1,P.AGN
PUSHJ SP,CERROR ; SP,CERROR
L.381: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,2 ; AC1,2
JRST L.382 ; L.382
MOVEI AC1,P.AGO ; AC1,P.AGO
PUSHJ SP,CERROR ; SP,CERROR
L.382: MOVE AC1,SCANUM ; AC1,SCANUM
CAIGE AC1,2 ; AC1,2
JRST L.383 ; L.383
CAIG AC1,12 ; AC1,12
JRST L.384 ; L.384
L.383: MOVEI AC1,P.AGP ; AC1,P.AGP
PUSHJ SP,CERROR ; SP,CERROR
L.384: MOVE AC1,SCANUM ; AC1,SCANUM
MOVEM AC1,CNSWRK+1(AC14) ; AC1,CNSWRK+1(FDB)
JRST L.425 ; L.425
L.385: CAIE AC13,71 ; AC13,71
JRST L.390 ; L.390
CAIE AC11,6 ; FNC,6
JRST L.386 ; L.386
MOVE AC1,AC14 ; AC1,FDB
SETO AC2, ; AC2,
MOVSI AC3,40 ; AC3,40
JRST L.414 ; L.414
L.386: CAIGE AC11,11 ; FNC,11
JRST L.387 ; L.387
CAIG AC11,12 ; FNC,12
JRST L.388 ; L.388
L.387: CAIE AC11,16 ; FNC,16
CAIN AC11,26 ; FNC,26
JRST L.388 ; L.388
JRST L.389 ; L.389
L.388: MOVSI AC1,10 ; AC1,10
JRST L.391 ; L.391
L.389: MOVEI AC1,P.AGQ ; AC1,P.AGQ
PUSHJ SP,CERROR ; SP,CERROR
JRST L.425 ; L.425
L.390: CAIE AC13,72 ; AC13,72
JRST L.392 ; L.392
MOVSI AC1,1 ; AC1,1
ANDCAM AC1,CNSWRK(AC14) ; AC1,CNSWRK(FDB)
MOVSI AC1,200 ; AC1,200
L.391: IORM AC1,CNSWRK(AC14) ; AC1,CNSWRK(FDB)
JRST L.425 ; L.425
L.392: CAIE AC13,73 ; AC13,73
JRST L.393 ; L.393
MOVSI AC1,200000 ; AC1,200000
JRST L.394 ; L.394
L.393: CAIE AC13,74 ; AC13,74
JRST L.395 ; L.395
MOVSI AC1,400000 ; AC1,400000
L.394: IORM AC1,CNSWRK+1(AC14) ; AC1,CNSWRK+1(FDB)
JRST L.425 ; L.425
L.395: CAIE AC13,102 ; AC13,102
JRST L.397 ; L.397
CAIE AC11,6 ; FNC,6
CAIN AC11,27 ; FNC,27
JRST L.396 ; L.396
MOVEI AC1,P.AGR ; AC1,P.AGR
PUSHJ SP,CERROR ; SP,CERROR
L.396: MOVE AC1,AC14 ; AC1,FDB
SETO AC2, ; AC2,
MOVSI AC3,100000 ; AC3,100000
JRST L.414 ; L.414
L.397: CAIE AC13,103 ; AC13,103
JRST L.399 ; L.399
CAIE AC11,6 ; FNC,6
CAIN AC11,27 ; FNC,27
JRST L.398 ; L.398
MOVEI AC1,P.AGS ; AC1,P.AGS
PUSHJ SP,CERROR ; SP,CERROR
L.398: MOVE AC1,AC14 ; AC1,FDB
SETO AC2, ; AC2,
MOVSI AC3,400000 ; AC3,400000
JRST L.414 ; L.414
L.399: CAIE AC13,104 ; AC13,104
JRST L.401 ; L.401
CAIE AC11,6 ; FNC,6
CAIN AC11,27 ; FNC,27
JRST L.400 ; L.400
MOVEI AC1,P.AGT ; AC1,P.AGT
PUSHJ SP,CERROR ; SP,CERROR
L.400: MOVSI AC1,100 ; AC1,100
IORM AC1,CNSWRK(AC14) ; AC1,CNSWRK(FDB)
MOVE AC1,AC14 ; AC1,FDB
SETO AC2, ; AC2,
MOVSI AC3,100 ; AC3,100
JRST L.414 ; L.414
L.401: CAIE AC13,105 ; AC13,105
JRST L.403 ; L.403
CAIE AC11,6 ; FNC,6
CAIN AC11,27 ; FNC,27
JRST L.402 ; L.402
MOVEI AC1,P.AGU ; AC1,P.AGU
PUSHJ SP,CERROR ; SP,CERROR
L.402: MOVE AC1,AC14 ; AC1,FDB
HRROI AC2,-2 ; AC2,-2
MOVSI AC3,10000 ; AC3,10000
JRST L.414 ; L.414
L.403: CAIE AC13,106 ; AC13,106
JRST L.405 ; L.405
CAIE AC11,6 ; FNC,6
CAIN AC11,27 ; FNC,27
JRST L.404 ; L.404
MOVEI AC1,P.AGV ; AC1,P.AGV
PUSHJ SP,CERROR ; SP,CERROR
L.404: MOVE AC1,AC14 ; AC1,FDB
SETO AC2, ; AC2,
MOVSI AC3,1000 ; AC3,1000
JRST L.414 ; L.414
L.405: CAIL AC13,75 ; AC13,75
CAILE AC13,100 ; AC13,100
JRST L.407 ; L.407
CAIE AC11,6 ; FNC,6
CAIN AC11,27 ; FNC,27
JRST L.406 ; L.406
MOVEI AC1,P.AGX ; AC1,P.AGX
PUSHJ SP,CERROR ; SP,CERROR
L.406: MOVE AC1,SCACOD ; AC1,SCACOD
MOVE AC12,DEF_LST-75(AC1) ; COD,DEF_LST-75(AC1)
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPSPRM ; SP,CPSPRM
MOVE AC3,AC1 ; STR,AC1
MOVE AC1,AC14 ; AC1,FDB
MOVE AC2,AC12 ; AC2,COD
PUSHJ SP,CPPRSF ; SP,CPPRSF
JRST L.428 ; L.428
L.407: CAIE AC13,101 ; AC13,101
JRST L.415 ; L.415
CAIE AC11,6 ; FNC,6
CAIN AC11,27 ; FNC,27
JRST L.408 ; L.408
MOVEI AC1,P.AGY ; AC1,P.AGY
PUSHJ SP,CERROR ; SP,CERROR
L.408: PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,2 ; AC1,2
JRST L.409 ; L.409
MOVE AC12,SCANUM ; CODE,SCANUM
JRST L.413 ; L.413
L.409: CAIE AC1,4 ; AC1,4
JRST L.410 ; L.410
MOVEI AC12,-1 ; CODE,-1
JRST L.413 ; L.413
L.410: CAIE AC1,5 ; AC1,5
JRST L.411 ; L.411
MOVEI AC12,-2 ; CODE,-2
JRST L.413 ; L.413
L.411: CAIE AC1,6 ; AC1,6
JRST L.412 ; L.412
MOVEI AC12,-3 ; CODE,-3
JRST L.413 ; L.413
L.412: MOVEI AC1,P.AGZ ; AC1,P.AGZ
PUSHJ SP,CERROR ; SP,CERROR
L.413: MOVE AC1,AC14 ; AC1,FDB
SETZ AC2, ; AC2,
MOVE AC3,AC12 ; AC3,CODE
L.414: PUSHJ SP,CPPRSF ; SP,CPPRSF
JRST L.425 ; L.425
L.415: CAIE AC13,107 ; AC13,107
JRST L.426 ; L.426
JUMPN AC10,L.416 ; FLG,L.416
MOVEI AC1,P.AHA ; AC1,P.AHA
JRST L.427 ; L.427
L.416: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.417 ; L.417
MOVEI AC1,CERM3 ; AC1,CERM3
PUSHJ SP,CERROR ; SP,CERROR
L.417: MOVE AC12,LBLCNT ; AC12,LBLCNT
MOVE AC3,SCALEN ; AC3,SCALEN
ADDI AC3,1 ; AC3,1
MOVE AC13,AC12 ; I,AC12
JRST L.419 ; L.419
L.418: MOVE AC2,C.3 ; HLF,[SCATOM]
HRLI AC2,-337100 ; HLF,-337100
MOVE AC1,AC3 ; AC1,AC3
MOVE AC4,AC3 ; AC4,AC3
MOVE AC5,LBLNAM(AC13) ; AC5,LBLNAM(I)
EXTEND AC1,C.5 ; AC1,[CMPSE ]
JRST L.419 ; L.419
JRST L.420 ; L.420
L.419: SOJGE AC13,L.418 ; I,L.418
SETO AC13, ; PTR,
L.420: JUMPGE AC13,L.422 ; PTR,L.422
CAIGE AC12,24 ; AC12,24
JRST L.421 ; L.421
MOVEI AC1,CERM10 ; AC1,CERM10
PUSHJ SP,CERROR ; SP,CERROR
L.421: MOVE AC12,LBLCNT ; AC12,LBLCNT
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,DICT ; AC2,DICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
HRLI AC1,-337100 ; HLF,-337100
MOVEM AC1,LBLNAM(AC12) ; HLF,LBLNAM(AC12)
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,1 ; AC1,1
MOVE AC2,C.3 ; HLF,[SCATOM]
HRLI AC2,-337100 ; HLF,-337100
MOVE AC3,LBLCNT ; AC3,LBLCNT
MOVE AC4,AC1 ; AC4,AC1
MOVE AC5,LBLNAM(AC3) ; AC5,LBLNAM(AC3)
EXTEND AC1,C.12 ; AC1,[MOVSLJ ]
JFCL ;
MOVE AC2,AC14 ; AC2,FDB
ADD AC2,C.40 ; AC2,[1000004]
MOVNM AC2,LBLADR(AC3) ; AC2,LBLADR(AC3)
AOS LBLCNT ; LBLCNT
SETZ AC13, ; PTR,
JRST L.424 ; L.424
L.422: MOVE AC1,LBLADR(AC13) ; AC1,LBLADR(PTR)
JUMPGE AC1,L.423 ; AC1,L.423
MOVN AC1,AC1 ; EPTR,AC1
MOVE AC2,AC14 ; AC2,FDB
ADD AC2,C.40 ; AC2,[1000004]
MOVNM AC2,LBLADR(AC13) ; AC2,LBLADR(PTR)
L.423: MOVE AC13,AC1 ; PTR,AC1
L.424: MOVE AC1,CNSWRK+4(AC14) ; HLFTMP,CNSWRK+4(FDB)
HRR AC1,AC13 ; HLFTMP,PTR
MOVEM AC1,CNSWRK+4(AC14) ; HLFTMP,CNSWRK+4(FDB)
L.425: PUSHJ SP,SCAN ; SP,SCAN
JRST L.428 ; L.428
L.426: MOVEI AC1,P.AHB ; AC1,P.AHB
L.427: PUSHJ SP,CERROR ; SP,CERROR
L.428: MOVEI AC1,21 ; AC1,21
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.373 ; L.373
MOVSI AC1,200 ; AC1,200
ANDCAM AC1,CNSWRK(AC14) ; AC1,CNSWRK(FDB)
MOVEI AC1,17 ; AC1,17
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.429 ; L.429
MOVEI AC1,P.AHC ; AC1,P.AHC
PUSHJ SP,CERROR ; SP,CERROR
L.429: PUSHJ SP,SCAN ; SP,SCAN
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
C.39: POINT 1,CNSWRK(AC14),10 ; 1,CNSWRK(FDB),10
C.40: EXP 1000004 ; 1000004
; Routine Size: 293 words
; 2998
; 2999 ROUTINE CPPRSW(FNC) = ! <Parse-option> WORDS
; 3000
; 3001 !++
; 3002 ! Functional description:
; 3003 ! Defines keyword table for Words option.
; 3004 !
; 3005 ! Formal parameters:
; 3006 ! Function code for field descriptor block being generated
; 3007 !
; 3008 ! Implicit inputs:
; 3009 ! Source
; 3010 !
; 3011 ! Implicit outputs:
; 3012 ! Constants
; 3013 !
; 3014 ! Routine value:
; 3015 ! Constant index of keyword table
; 3016 !
; 3017 ! Side effects:
; 3018 ! Scans from WORDS past final right parenthesis
; 3019 !
; 3020 !--
; 3021
; 3022 BEGIN
; 3023 EXTERNAL REGISTER Z=0;
; 3024 LOCAL
; 3025 PTR, ! Word index
; 3026 IPTR, ! Byte pointers
; 3027 OPTR,
; 3028 CHR,
; 3029 HLFTMP: HLF_WRD, ! Temporary
; 3030 TBL, ! Table pointer
; 3031 WTBL: VECTOR[100], ! Word pointers
; 3032 VTBL: VECTOR[100]; ! Word values
; 3033 IF .FNC NEQ $CMKEY AND .FNC NEQ $CMSWI
; 3034 THEN
; 3035 ERROR('Word list only for keywords and switches');
; 3036 IF SCAN() NEQ SCN_LPAREN THEN CERROR(CERM16);
; 3037
; 3038 PTR = -1;
; 3039 DO
; 3040 BEGIN
; 3041 SCATRP = -1;
; 3042 IF SCAN() NEQ SCN_IDENT AND .SCACOD NEQ SCN_NUMB
; 3043 THEN
; 3044 ERROR('Word missing');
; 3045 SCATRP = 0;
; 3046 IF .SCACOD EQL SCN_NUMB
; 3047 THEN
; 3048 CH$WCHAR($CHNUL, PCMITS(.SCANUM,BYTPTR(SCATOM)));
; 3049 IF SCAN() NEQ SCN_COLON THEN CERROR(CERM11);
; 3050 IPTR = CH$PTR(SCATOM);
; 3051 OPTR = .IPTR;
; 3052 DO
; 3053 BEGIN
; 3054 CHR = CH$RCHAR_A(IPTR);
; 3055 IF .CHR EQL %C'_' THEN CHR = %C'-';
; 3056 CH$WCHAR_A(.CHR,OPTR)
; 3057 END
; 3058 UNTIL
; 3059 .CHR EQL $CHNUL;
; 3060 IF SCAN() EQL SCN_COLON
; 3061 THEN
; 3062 BEGIN
; 3063 CH$WCHAR(%C':',CH$PTR(SCATOM,.SCALEN));
; 3064 SCALEN = .SCALEN + 1;
; 3065 SCAN();
; 3066 END;
; 3067 PTR = .PTR + 1;
; 3068 IF .PTR GTR 100 THEN ERROR('Too many keywords');
; 3069 IF .CONSTP + (.SCALEN+5)/5 GTR CNSWKL
; 3070 THEN
; 3071 CERROR(CERM1);
; 3072 CH$COPY(.SCALEN,CH$PTR(SCATOM),
; 3073 0,.SCALEN+1,CH$PTR(CNSWRK[.CONSTP]));
; 3074 WTBL[.PTR] = .CONSTP;
; 3075 CONSTP = .CONSTP + (.SCALEN+5)/5;
; 3076 IF .SCACOD EQL SCN_MINUS
; 3077 THEN
; 3078 BEGIN
; 3079 IF SCAN() NEQ SCN_NUMB THEN ERROR('Word value missing');
; 3080 IF .SCANUM GEQ %O'1000000'
; 3081 THEN
; 3082 ERROR('Word value must be greater than -262144');
; 3083 SCANUM = -.SCANUM
; 3084 END
; 3085 ELSE
; 3086 BEGIN
; 3087 IF .SCACOD NEQ SCN_NUMB THEN ERROR('Word value missing');
; 3088 IF .SCANUM GEQ %O'777777'
; 3089 THEN
; 3090 ERROR('Word value must be less than 262143')
; 3091 END;
; 3092 VTBL[.PTR] = .SCANUM AND %O'777777' ! Make halfword even if negative
; 3093 END
; 3094 UNTIL
; 3095 SCAN() NEQ SCN_COMMA;
; 3096 IF .SCACOD NEQ SCN_RPAREN THEN CERROR(CERM14);
; 3097 SCAN();
; 3098 IF .CONSTP + .PTR +2 GEQ CNSWKL
; 3099 THEN
; 3100 CERROR(CERM1);
; 3101 TBL = .CONSTP;
; 3102 CONSTP = .CONSTP + .PTR + 2;
; 3103 CNSWRK[.TBL] = .PTR + 1;
; 3104 %( Must be a better way to alphabetize the table )%
; 3105 DECR I FROM .PTR DO
; 3106 BEGIN
; 3107 REGISTER R1=1,R2=2;
; 3108 BUILTIN JSYS;
; 3109 R1 = CNSWRK[.TBL];
; 3110 R2 = CNSWRK[.WTBL[.I]]^18 + .VTBL[.I];
; 3111 JSYS(-1,TBADD,R1,R2)
; 3112 END;
; 3113 DECR I FROM .PTR DO
; 3114 BEGIN
; 3115 HLFTMP = .CNSWRK[.TBL+.I+1];
; 3116 HLFTMP[HLF_LFT] = .HLFTMP[HLF_LFT] - CNSWRK;
; 3117 CNSWRK[.TBL+.I+1] = .HLFTMP
; 3118 END;
; 3119 .TBL
; 3120 END;
P.AHD: BYTE (7)"W","o","r","d"," " ; Word
BYTE (7)"l","i","s","t"," " ; list
BYTE (7)"o","n","l","y"," " ; only
BYTE (7)"f","o","r"," ","k" ; for k
BYTE (7)"e","y","w","o","r" ; eywor
BYTE (7)"d","s"," ","a","n" ; ds an
BYTE (7)"d"," ","s","w","i" ; d swi
BYTE (7)"t","c","h","e","s" ; tches
BYTE (7)000,000,000,000,000
P.AHE: BYTE (7)"W","o","r","d"," " ; Word
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
P.AHF: BYTE (7)"T","o","o"," ","m" ; Too m
BYTE (7)"a","n","y"," ","k" ; any k
BYTE (7)"e","y","w","o","r" ; eywor
BYTE (7)"d","s",000,000,000 ; ds
P.AHG: BYTE (7)"W","o","r","d"," " ; Word
BYTE (7)"v","a","l","u","e" ; value
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
P.AHH: BYTE (7)"W","o","r","d"," " ; Word
BYTE (7)"v","a","l","u","e" ; value
BYTE (7)" ","m","u","s","t" ; must
BYTE (7)" ","b","e"," ","g" ; be g
BYTE (7)"r","e","a","t","e" ; reate
BYTE (7)"r"," ","t","h","a" ; r tha
BYTE (7)"n"," ","-","2","6" ; n -26
BYTE (7)"2","1","4","4",000 ; 2144
P.AHI: BYTE (7)"W","o","r","d"," " ; Word
BYTE (7)"v","a","l","u","e" ; value
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
P.AHJ: BYTE (7)"W","o","r","d"," " ; Word
BYTE (7)"v","a","l","u","e" ; value
BYTE (7)" ","m","u","s","t" ; must
BYTE (7)" ","b","e"," ","l" ; be l
BYTE (7)"e","s","s"," ","t" ; ess t
BYTE (7)"h","a","n"," ","2" ; han 2
BYTE (7)"6","2","1","4","3" ; 62143
BYTE (7)000,000,000,000,000
CPPRSW: PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,310 ; SP,310
JUMPE AC1,L.430 ; FNC,L.430
CAIN AC1,3 ; FNC,3
JRST L.430 ; L.430
MOVEI AC1,P.AHD ; AC1,P.AHD
PUSHJ SP,CERROR ; SP,CERROR
L.430: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,16 ; AC1,16
JRST L.431 ; L.431
MOVEI AC1,CERM16 ; AC1,CERM16
PUSHJ SP,CERROR ; SP,CERROR
L.431: SETO AC13, ; PTR,
L.432: SETOM SCATRP ; SCATRP
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,1 ; AC1,1
JRST L.433 ; L.433
MOVEI AC1,2 ; AC1,2
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.433 ; L.433
MOVEI AC1,P.AHE ; AC1,P.AHE
PUSHJ SP,CERROR ; SP,CERROR
L.433: SETZM SCATRP ; SCATRP
MOVEI AC1,2 ; AC1,2
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.434 ; L.434
SETZ AC14, ; AC14,
MOVE AC2,C.3 ; HLF,[SCATOM]
HRLI AC2,-337100 ; HLF,-337100
MOVE AC1,SCANUM ; AC1,SCANUM
PUSHJ SP,PCMITS ; SP,PCMITS
IDPB AC14,AC1 ; AC14,AC1
L.434: PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,22 ; AC1,22
JRST L.435 ; L.435
MOVEI AC1,CERM11 ; AC1,CERM11
PUSHJ SP,CERROR ; SP,CERROR
L.435: MOVE AC11,C.2 ; IPTR,[POINT 7,BUF0+11062,34] <1,7>
MOVE AC10,AC11 ; OPTR,IPTR
L.436: ILDB AC12,AC11 ; CHR,IPTR
CAIN AC12,137 ; CHR,137
MOVEI AC12,55 ; CHR,55
IDPB AC12,AC10 ; CHR,OPTR
JUMPN AC12,L.436 ; CHR,L.436
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,22 ; AC1,22
JRST L.437 ; L.437
MOVEI AC2,72 ; AC2,72
MOVE AC3,C.41 ; AC3,[POINT 7,SCATOM,-1] <36,7>
MOVE AC1,SCALEN ; AC1,SCALEN
ADJBP AC1,AC3 ; AC1,AC3
IDPB AC2,AC1 ; AC2,AC1
AOS SCALEN ; SCALEN
PUSHJ SP,SCAN ; SP,SCAN
L.437: ADDI AC13,1 ; PTR,1
CAIG AC13,144 ; PTR,144
JRST L.438 ; L.438
MOVEI AC1,P.AHF ; AC1,P.AHF
PUSHJ SP,CERROR ; SP,CERROR
L.438: MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
ADD AC1,CONSTP ; AC1,CONSTP
CAIG AC1,6000 ; AC1,6000
JRST L.439 ; L.439
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.439: MOVE AC4,SCALEN ; AC4,SCALEN
ADDI AC4,1 ; AC4,1
MOVE AC3,CONSTP ; AC3,CONSTP
MOVEI AC5,CNSWRK-1(AC3) ; AC5,CNSWRK-1(AC3)
HRLI AC5,10700 ; AC5,10700
MOVE AC1,SCALEN ; AC1,SCALEN
MOVE AC2,C.2 ; AC2,[POINT 7,BUF0+11062,34] <1,7>
EXTEND AC1,C.8 ; AC1,C.8
JFCL ;
MOVEI AC1,-307(SP) ; AC1,WTBL
ADD AC1,AC13 ; AC1,PTR
MOVEM AC3,0(AC1) ; AC3,0(AC1)
MOVE AC1,SCALEN ; AC1,SCALEN
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
ADDM AC1,CONSTP ; AC1,CONSTP
MOVE AC14,SCACOD ; AC14,SCACOD
CAIE AC14,5 ; AC14,5
JRST L.442 ; L.442
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,2 ; AC1,2
JRST L.440 ; L.440
MOVEI AC1,P.AHG ; AC1,P.AHG
PUSHJ SP,CERROR ; SP,CERROR
L.440: MOVSI AC1,1 ; AC1,1
CAMLE AC1,SCANUM ; AC1,SCANUM
JRST L.441 ; L.441
MOVEI AC1,P.AHH ; AC1,P.AHH
PUSHJ SP,CERROR ; SP,CERROR
L.441: MOVNS SCANUM ; SCANUM
JRST L.444 ; L.444
L.442: CAIN AC14,2 ; AC14,2
JRST L.443 ; L.443
MOVEI AC1,P.AHI ; AC1,P.AHI
PUSHJ SP,CERROR ; SP,CERROR
L.443: MOVEI AC1,-1 ; AC1,-1
CAMLE AC1,SCANUM ; AC1,SCANUM
JRST L.444 ; L.444
MOVEI AC1,P.AHJ ; AC1,P.AHJ
PUSHJ SP,CERROR ; SP,CERROR
L.444: MOVEI AC1,-143(SP) ; AC1,VTBL
ADD AC1,AC13 ; AC1,PTR
HRRZ AC2,SCANUM ; AC2,SCANUM
MOVEM AC2,0(AC1) ; AC2,0(AC1)
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,21 ; AC1,21
JRST L.432 ; L.432
MOVEI AC1,17 ; AC1,17
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.445 ; L.445
MOVEI AC1,CERM14 ; AC1,CERM14
PUSHJ SP,CERROR ; SP,CERROR
L.445: PUSHJ SP,SCAN ; SP,SCAN
MOVE AC1,CONSTP ; AC1,CONSTP
ADD AC1,AC13 ; AC1,PTR
ADDI AC1,2 ; AC1,2
CAIGE AC1,6000 ; AC1,6000
JRST L.446 ; L.446
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.446: MOVE AC3,CONSTP ; TBL,CONSTP
MOVE AC1,CONSTP ; AC1,CONSTP
ADD AC1,AC13 ; AC1,PTR
ADDI AC1,2 ; AC1,2
MOVEM AC1,CONSTP ; AC1,CONSTP
MOVE AC1,AC13 ; AC1,PTR
ADDI AC1,1 ; AC1,1
MOVEM AC1,CNSWRK(AC3) ; AC1,CNSWRK(TBL)
MOVE AC5,AC13 ; I,PTR
AOJA AC5,L.448 ; I,L.448
L.447: MOVE AC1,AC3 ; R1,TBL
ADD AC1,C.9 ; R1,[CNSWRK]
MOVEI AC2,-307(SP) ; AC2,WTBL
ADD AC2,AC5 ; AC2,I
MOVE AC2,0(AC2) ; AC2,0(AC2)
ADD AC2,C.9 ; AC2,[CNSWRK]
MOVSI AC2,0(AC2) ; AC2,0(AC2)
MOVEI AC4,-143(SP) ; AC4,VTBL
ADD AC4,AC5 ; AC4,I
ADD AC2,0(AC4) ; AC2,0(AC4)
JSYS 536 ; 536
JUMP 16,L.448 ; 16,L.448
L.448: SOJGE AC5,L.447 ; I,L.447
MOVE AC5,AC13 ; I,PTR
AOJA AC5,L.450 ; I,L.450
L.449: MOVE AC1,AC3 ; AC1,TBL
ADD AC1,AC5 ; AC1,I
MOVE AC2,CNSWRK+1(AC1) ; HLFTMP,CNSWRK+1(AC1)
HLRZ AC4,AC2 ; AC4,HLFTMP
SUB AC4,C.9 ; AC4,[CNSWRK]
HRL AC2,AC4 ; HLFTMP,AC4
MOVEM AC2,CNSWRK+1(AC1) ; HLFTMP,CNSWRK+1(AC1)
L.450: SOJGE AC5,L.449 ; I,L.449
MOVE AC1,AC3 ; AC1,TBL
ADJSP SP,-310 ; SP,-310
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
C.41: POINT 7,SCATOM,-1 ; 7,SCATOM,-1
; Routine Size: 173 words
; 3121
; 3122 ROUTINE CPPRSF(FDB,COD,VAL): NOVALUE = ! File parse options
; 3123
; 3124 !++
; 3125 ! Functional description:
; 3126 ! Fill in words of GTJFN block, creating it if it does not
; 3127 ! yet exist.
; 3128 !
; 3129 ! Formal parameters:
; 3130 ! Constant index of FLDDB
; 3131 ! Index into GTJFN block of word to define, -1 for flags,
; 3132 ! -2 for secondary flags
; 3133 ! Value to place in word (or to OR into word if index is negative)
; 3134 !
; 3135 ! Implicit inputs:
; 3136 ! Pointer in .CMDAT
; 3137 !
; 3138 ! Implicit outputs:
; 3139 ! None
; 3140 !
; 3141 ! Routine value:
; 3142 ! None
; 3143 !
; 3144 ! Side effects:
; 3145 ! None
; 3146 !
; 3147 !--
; 3148
; 3149 BEGIN
; 3150 EXTERNAL REGISTER Z=0;
; 3151 LOCAL
; 3152 PTR; ! Location of option list
; 3153 PTR = .CNSWRK[.FDB+$CMDAT];
; 3154 IF .PTR EQL 0
; 3155 THEN
; 3156 BEGIN
; 3157 PTR = CNSWRK[.FDB+$CMDAT] = .CONSTP;
; 3158 CONSTP = .CONSTP + 6;
; 3159 IF .CONSTP GEQ CNSWKL THEN CERROR(CERM1);
; 3160 CNSWRK[.PTR] = 0; ! Flags and generation
; 3161 CNSWRK[.PTR+1] = 0; ! Secondary flags
; 3162 CNSWRK[.PTR+$GJDEV] = -1; ! Device
; 3163 CNSWRK[.PTR+$GJDIR] = -1; ! Directory
; 3164 CNSWRK[.PTR+$GJNAM] = -1; ! Name
; 3165 CNSWRK[.PTR+$GJEXT] = -1 ! Type
; 3166 END;
; 3167 IF .COD LSS 0
; 3168 THEN
; 3169 BEGIN
; 3170 CNSWRK[.PTR-(.COD+1)] = .CNSWRK[.PTR-(.COD+1)] OR .VAL;
; 3171 !GJ%IFG and GJ%OFG together give strange results which the user
; 3172 !probably doesn't want. Therefore, If the user has specified
; 3173 !both WILD and PARSEONLY clear GJ%IFG:
; 3174 IF .POINTR((CNSWRK[.PTR-(.COD+1)]),GJ_OFG) NEQ 0
; 3175 THEN
; 3176 POINTR((CNSWRK[.PTR-(.COD+1)]),GJ_IFG) = 0;
; 3177 END
; 3178 ELSE
; 3179 IF .COD EQL $GJGEN
; 3180 THEN
; 3181 BEGIN
; 3182 LOCAL
; 3183 HLF: HLF_WRD;
; 3184 HLF = .CNSWRK[.PTR+$GJGEN];
; 3185 HLF[HLF_RGT] = .VAL;
; 3186 CNSWRK[.PTR+$GJGEN] = .HLF
; 3187 END
; 3188 ELSE
; 3189 CNSWRK[.PTR+.COD] = .VAL
; 3190 END;
CPPRSF: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC12,AC3 ; VAL,AC3
MOVE AC13,AC2 ; COD,AC2
MOVE AC14,CNSWRK+1(AC1) ; PTR,CNSWRK+1(FDB)
JUMPN AC14,L.452 ; PTR,L.452
MOVE AC2,CONSTP ; AC2,CONSTP
MOVEM AC2,CNSWRK+1(AC1) ; AC2,CNSWRK+1(FDB)
MOVE AC14,AC2 ; PTR,AC2
MOVEI AC1,6 ; AC1,6
ADDM AC1,CONSTP ; AC1,CONSTP
MOVEI AC1,6000 ; AC1,6000
CAMLE AC1,CONSTP ; AC1,CONSTP
JRST L.451 ; L.451
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.451: SETZM CNSWRK(AC14) ; CNSWRK(PTR)
SETZM CNSWRK+1(AC14) ; CNSWRK+1(PTR)
SETOM CNSWRK+2(AC14) ; CNSWRK+2(PTR)
SETOM CNSWRK+3(AC14) ; CNSWRK+3(PTR)
SETOM CNSWRK+4(AC14) ; CNSWRK+4(PTR)
SETOM CNSWRK+5(AC14) ; CNSWRK+5(PTR)
L.452: JUMPGE AC13,L.453 ; COD,L.453
MOVE AC1,AC14 ; AC1,PTR
SUB AC1,AC13 ; AC1,COD
IORM AC12,CNSWRK-1(AC1) ; VAL,CNSWRK-1(AC1)
LDB AC2,C.42 ; AC2,[POINT 1,CNSWRK-1(AC1),12] <23,1>
JUMPE AC2,L.455 ; AC2,L.455
MOVSI AC2,100 ; AC2,100
ANDCAM AC2,CNSWRK-1(AC1) ; AC2,CNSWRK-1(AC1)
JRST L.455 ; L.455
L.453: JUMPN AC13,L.454 ; COD,L.454
MOVE AC1,CNSWRK(AC14) ; HLF,CNSWRK(PTR)
HRR AC1,AC12 ; HLF,VAL
MOVEM AC1,CNSWRK(AC14) ; HLF,CNSWRK(PTR)
JRST L.455 ; L.455
L.454: ADD AC14,AC13 ; PTR,COD
MOVEM AC12,CNSWRK(AC14) ; VAL,CNSWRK(AC14)
L.455: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.42: POINT 1,CNSWRK-1(AC1),12 ; 1,CNSWRK-1(AC1),12
; Routine Size: 44 words
; 3191
; 3192 ROUTINE CPTYIN: NOVALUE = ! Typein statement
; 3193
; 3194 !++
; 3195 ! Functional description:
; 3196 ! Compiles a Typein statement.
; 3197 !
; 3198 ! Formal parameters:
; 3199 ! None
; 3200 !
; 3201 ! Implicit inputs:
; 3202 ! Source
; 3203 !
; 3204 ! Implicit outputs:
; 3205 ! Code
; 3206 !
; 3207 ! Routine value:
; 3208 ! None
; 3209 !
; 3210 ! Side effects:
; 3211 ! Scans from TYPEIN to atom after argument
; 3212 !
; 3213 !--
; 3214
; 3215 BEGIN
; 3216 EXTERNAL REGISTER Z=0;
; 3217 LOCAL
; 3218 OPR; ! Operation code to use
; 3219 OPR = OPR_TIN;
; 3220 IF SCAN() EQL SCN_NORETURN
; 3221 THEN
; 3222 BEGIN
; 3223 OPR = OPR_TIX;
; 3224 SCAN()
; 3225 END;
; 3226 GENINS(.OPR,CPSEXP(OPN_TMP_STR),0,0)
; 3227 END;
CPTYIN: PUSH SP,AC14 ; SP,AC14
MOVEI AC14,33 ; OPR,33
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,116 ; AC1,116
JRST L.456 ; L.456
MOVEI AC14,34 ; OPR,34
PUSHJ SP,SCAN ; SP,SCAN
L.456: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
MOVE AC2,AC1 ; AC2,AC1
MOVE AC1,AC14 ; AC1,OPR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 15 words
; 3228
; 3229 ROUTINE CPDPLY: NOVALUE = ! Display statement
; 3230
; 3231 !++
; 3232 ! Functional description:
; 3233 ! Compiles a Display statement.
; 3234 !
; 3235 ! Formal parameters:
; 3236 ! None
; 3237 !
; 3238 ! Implicit inputs:
; 3239 ! Source
; 3240 !
; 3241 ! Implicit outputs:
; 3242 ! Code
; 3243 !
; 3244 ! Routine value:
; 3245 ! None
; 3246 !
; 3247 ! Side effects:
; 3248 ! Scans from DISPLAY to unrecognized atom
; 3249 !
; 3250 !--
; 3251
; 3252 BEGIN
; 3253 EXTERNAL REGISTER Z=0;
; 3254 LOCAL
; 3255 TYP, ! Operand type (STE_TYP_INT or STE_TYP_STR)
; 3256 OPR; ! Operation code to use
; 3257 OPR = OPR_DPY;
; 3258 IF SCAN() EQL SCN_BINARY
; 3259 THEN
; 3260 BEGIN
; 3261 OPR = OPR_DPB;
; 3262 SCAN()
; 3263 END
; 3264 ELSE
; 3265 IF .SCACOD EQL SCN_NORETURN
; 3266 THEN
; 3267 BEGIN
; 3268 OPR = OPR_DPN;
; 3269 SCAN()
; 3270 END;
; 3271 TYP = CPCLSE(); ! Get type of expression
; 3272 IF .TYP EQL STE_TYP_INT ! Integer?
; 3273 THEN ! Yes
; 3274 BEGIN
; 3275 OPR = (SELECTONE .OPR OF
; 3276 SET
; 3277 [OPR_DPY]: OPR_DIY;
; 3278 [OPR_DPB]: OPR_DIB;
; 3279 [OPR_DPN]: OPR_DIN;
; 3280 TES);
; 3281 GENINS(.OPR,CPIEXP(OPN_TMP_INT),0,0)
; 3282 END
; 3283 ELSE ! No, so had better be a string...
; 3284 GENINS(.OPR,CPSEXP(OPN_TMP_STR),0,0)
; 3285 END;
CPDPLY: PUSH SP,AC14 ; SP,AC14
MOVEI AC14,37 ; OPR,37
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,123 ; AC1,123
JRST L.457 ; L.457
MOVEI AC14,40 ; OPR,40
JRST L.458 ; L.458
L.457: MOVEI AC1,116 ; AC1,116
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.459 ; L.459
MOVEI AC14,41 ; OPR,41
L.458: PUSHJ SP,SCAN ; SP,SCAN
L.459: PUSHJ SP,CPCLSE ; SP,CPCLSE
JUMPN AC1,L.464 ; TYP,L.464
CAIE AC14,37 ; OPR,37
JRST L.460 ; L.460
MOVEI AC14,52 ; OPR,52
JRST L.463 ; L.463
L.460: CAIE AC14,40 ; OPR,40
JRST L.461 ; L.461
MOVEI AC14,53 ; OPR,53
JRST L.463 ; L.463
L.461: CAIN AC14,41 ; OPR,41
JRST L.462 ; L.462
SETO AC14, ; OPR,
JRST L.463 ; L.463
L.462: MOVEI AC14,54 ; OPR,54
L.463: MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
JRST L.465 ; L.465
L.464: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
L.465: MOVE AC2,AC1 ; AC2,AC1
MOVE AC1,AC14 ; AC1,OPR
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 38 words
; 3286
; 3287 ROUTINE CPEXIT: NOVALUE = ! Exit statement
; 3288
; 3289 !++
; 3290 ! Functional description:
; 3291 ! Compiles an Exit statement.
; 3292 !
; 3293 ! Formal parameters:
; 3294 ! None
; 3295 !
; 3296 ! Implicit inputs:
; 3297 ! Source
; 3298 !
; 3299 ! Implicit outputs:
; 3300 ! Code
; 3301 !
; 3302 ! Routine value:
; 3303 ! None
; 3304 !
; 3305 ! Side effects:
; 3306 ! Scans from keyword to unrecognized atom
; 3307 !
; 3308 !--
; 3309
; 3310 BEGIN
; 3311 EXTERNAL REGISTER Z=0;
; 3312 LOCAL
; 3313 OPT; ! Options
; 3314 OPT = 0;
; 3315 IF SCAN() EQL SCN_SAVE
; 3316 THEN
; 3317 OPT = 1
; 3318 ELSE
; 3319 IF .SCACOD EQL SCN_TOPROGRAM
; 3320 THEN
; 3321 OPT = 2;
; 3322 IF .OPT NEQ 0 THEN SCAN();
; 3323 GENINS(OPR_XIT, .OPT, 0, 0)
; 3324 END;
CPEXIT: PUSH SP,AC14 ; SP,AC14
SETZ AC14, ; OPT,
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,125 ; AC1,125
JRST L.466 ; L.466
MOVEI AC14,1 ; OPT,1
JRST L.467 ; L.467
L.466: MOVEI AC1,126 ; AC1,126
CAMN AC1,SCACOD ; AC1,SCACOD
MOVEI AC14,2 ; OPT,2
L.467: JUMPE AC14,L.468 ; OPT,L.468
PUSHJ SP,SCAN ; SP,SCAN
L.468: MOVEI AC1,42 ; AC1,42
MOVE AC2,AC14 ; AC2,OPT
SETZB AC3,AC4 ; AC3,AC4
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 18 words
; 3325
; 3326 ROUTINE CPCALL: NOVALUE = ! <Call-statement>
; 3327
; 3328 !++
; 3329 ! Functional description:
; 3330 ! Called from <Statement> to compile a CALL statement,
; 3331 ! generating a CAL instruction with the appropriate operands;
; 3332 ! generate actual parameter list in constant table.
; 3333 !
; 3334 ! Formal parameters:
; 3335 ! None
; 3336 !
; 3337 ! Implicit inputs:
; 3338 ! Source
; 3339 !
; 3340 ! Implicit outputs:
; 3341 ! Code, constants
; 3342 !
; 3343 ! Routine value:
; 3344 ! None
; 3345 !
; 3346 ! Side effects:
; 3347 ! Scans from CALL to unrecognized atom
; 3348 !
; 3349 !--
; 3350
; 3351 BEGIN
; 3352 EXTERNAL REGISTER Z=0;
; 3353 LOCAL
; 3354 PDESIG, ! Procedure designator
; 3355 PLIST, ! Actual parameter list constant index
; 3356 LINE, ! Line number of CALL
; 3357 SAVELINE; ! Save for real line number
; 3358 LINE = .SCALIN;
; 3359 IF SCAN() EQL SCN_IDENT
; 3360 THEN
; 3361 BEGIN
; 3362 PDESIG = FNDSMB(STE_CLS_PRC,-1);
; 3363 IF .PDESIG LSS 0 THEN ERROR('Procedure not defined')
; 3364 END
; 3365 ELSE
; 3366 IF .SCACOD EQL SCN_SYSNAME
; 3367 THEN
; 3368 BEGIN
; 3369 MAP PDESIG: OPRAND;
; 3370 IF .PSDEFN[.SCATOM,SYN_CLS] NEQ SYN_CLS_PRC
; 3371 THEN
; 3372 ERROR('Typed routine cannot be CALLed');
; 3373 PDESIG[OPN_ADR] = .SCATOM;
; 3374 PDESIG[OPN_CLS] = OPN_CLS_SYN
; 3375 END
; 3376 ELSE
; 3377 ERROR('Procedure name missing');
; 3378 PLIST = -1;
; 3379 IF SCAN() EQL SCN_LPAREN THEN CPACTL(PLIST);
; 3380 SAVELINE = .SCALIN;
; 3381 SCALIN = .LINE;
; 3382 GENINS(OPR_CAL,.PDESIG,.PLIST,0);
; 3383 SCALIN = .SAVELINE
; 3384 END;
P.AHK: BYTE (7)"P","r","o","c","e" ; Proce
BYTE (7)"d","u","r","e"," " ; dure
BYTE (7)"n","o","t"," ","d" ; not d
BYTE (7)"e","f","i","n","e" ; efine
BYTE (7)"d",000,000,000,000 ; d
P.AHL: BYTE (7)"T","y","p","e","d" ; Typed
BYTE (7)" ","r","o","u","t" ; rout
BYTE (7)"i","n","e"," ","c" ; ine c
BYTE (7)"a","n","n","o","t" ; annot
BYTE (7)" ","b","e"," ","C" ; be C
BYTE (7)"A","L","L","e","d" ; ALLed
BYTE (7)000,000,000,000,000
P.AHM: BYTE (7)"P","r","o","c","e" ; Proce
BYTE (7)"d","u","r","e"," " ; dure
BYTE (7)"n","a","m","e"," " ; name
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
CPCALL: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,1 ; SP,1
MOVE AC12,SCALIN ; LINE,SCALIN
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,1 ; AC1,1
JRST L.469 ; L.469
MOVEI AC1,3 ; AC1,3
SETO AC2, ; AC2,
PUSHJ SP,FNDSMB ; SP,FNDSMB
MOVE AC13,AC1 ; PDESIG,AC1
JUMPGE AC13,L.473 ; PDESIG,L.473
MOVEI AC1,P.AHK ; AC1,P.AHK
JRST L.472 ; L.472
L.469: MOVEI AC1,112 ; AC1,112
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.471 ; L.471
MOVE AC1,SCATOM ; AC1,SCATOM
IMULI AC1,2 ; AC1,2
LDB AC2,C.31 ; AC2,[POINT 3,PSDEFN(AC1),17] <18,3>
JUMPE AC2,L.470 ; AC2,L.470
MOVEI AC1,P.AHL ; AC1,P.AHL
PUSHJ SP,CERROR ; SP,CERROR
L.470: MOVE AC1,SCATOM ; AC1,SCATOM
DPB AC1,C.32 ; AC1,[POINT 15,AC13,35] <0,15>
TRZ AC13,-200000 ; PDESIG,-200000
TRO AC13,200000 ; PDESIG,200000
JRST L.473 ; L.473
L.471: MOVEI AC1,P.AHM ; AC1,P.AHM
L.472: PUSHJ SP,CERROR ; SP,CERROR
L.473: SETOM 0(SP) ; PLIST
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,16 ; AC1,16
JRST L.474 ; L.474
MOVEI AC1,0(SP) ; AC1,PLIST
PUSHJ SP,CPACTL ; SP,CPACTL
L.474: MOVE AC14,SCALIN ; SAVELINE,SCALIN
MOVEM AC12,SCALIN ; LINE,SCALIN
MOVEI AC1,23 ; AC1,23
MOVE AC2,AC13 ; AC2,PDESIG
MOVE AC3,0(SP) ; AC3,PLIST
SETZ AC4, ; AC4,
PUSHJ SP,GENINS ; SP,GENINS
MOVEM AC14,SCALIN ; SAVELINE,SCALIN
ADJSP SP,-1 ; SP,-1
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 50 words
; 3385
; 3386 ROUTINE CPACTL(LIST): NOVALUE = ! <Actual-parameter-list>
; 3387
; 3388 !++
; 3389 ! Functional description:
; 3390 ! Processes actual parameter list in source, generating in the
; 3391 ! constants area the corresponding list of operand descriptors.
; 3392 !
; 3393 ! Formal parameters:
; 3394 ! Address of word in which to store constant index of argument list
; 3395 !
; 3396 ! Implicit inputs:
; 3397 ! Symbol table, source
; 3398 !
; 3399 ! Implicit outputs:
; 3400 ! Constants
; 3401 !
; 3402 ! Routine value:
; 3403 ! None
; 3404 !
; 3405 ! Side effects:
; 3406 ! Scans from ( past )
; 3407 !
; 3408 !--
; 3409
; 3410 BEGIN
; 3411 EXTERNAL REGISTER Z=0;
; 3412 LOCAL
; 3413 PCNT, ! Argument count
; 3414 IPTR, ! Temporary pointers
; 3415 OPTR,
; 3416 TBL: VECTOR[MAXPRM]; ! Argument list being created
; 3417 OPTR = TBL[0];
; 3418 PCNT = 0;
; 3419 DO
; 3420 BEGIN
; 3421 LOCAL
; 3422 TYPE; ! Data type
; 3423 SCAN();
; 3424 TYPE = CPCLSE();
; 3425 IF .TYPE LSS 0 THEN CERROR(CERM18);
; 3426 IF .TYPE EQL STE_TYP_INT
; 3427 THEN
; 3428 .OPTR = CPIEXP(OPN_TMP_INT)
; 3429 ELSE
; 3430 .OPTR = CPSEXP(OPN_TMP_STR);
; 3431 OPTR = .OPTR + 1;
; 3432 PCNT = .PCNT + 1;
; 3433 IF .SCACOD NEQ SCN_COMMA AND .SCACOD NEQ SCN_RPAREN
; 3434 THEN
; 3435 ERROR('Comma or parenthesis missing after actual argument')
; 3436 END
; 3437 UNTIL
; 3438 .SCACOD EQL SCN_RPAREN;
; 3439 SCAN();
; 3440 .LIST = .CONSTP;
; 3441 OPTR = CNSWRK[.CONSTP];
; 3442 .OPTR = .PCNT;
; 3443 CONSTP = .CONSTP + .PCNT + 1;
; 3444 IPTR = TBL[0];
; 3445 DO
; 3446 (OPTR=.OPTR+1; .OPTR=..IPTR; IPTR=.IPTR+1)
; 3447 UNTIL
; 3448 (PCNT=.PCNT-1) LEQ 0
; 3449 END;
P.AHN: BYTE (7)"C","o","m","m","a" ; Comma
BYTE (7)" ","o","r"," ","p" ; or p
BYTE (7)"a","r","e","n","t" ; arent
BYTE (7)"h","e","s","i","s" ; hesis
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g"," ","a" ; ing a
BYTE (7)"f","t","e","r"," " ; fter
BYTE (7)"a","c","t","u","a" ; actua
BYTE (7)"l"," ","a","r","g" ; l arg
BYTE (7)"u","m","e","n","t" ; ument
BYTE (7)000,000,000,000,000
CPACTL: PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,10 ; SP,10
MOVE AC11,AC1 ; LIST,AC1
MOVEI AC14,-7(SP) ; OPTR,TBL
SETZ AC12, ; PCNT,
L.475: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPCLSE ; SP,CPCLSE
MOVE AC13,AC1 ; TYPE,AC1
JUMPGE AC13,L.476 ; TYPE,L.476
MOVEI AC1,CERM18 ; AC1,CERM18
PUSHJ SP,CERROR ; SP,CERROR
L.476: JUMPN AC13,L.477 ; TYPE,L.477
MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
JRST L.478 ; L.478
L.477: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
L.478: MOVEM AC1,0(AC14) ; AC1,0(OPTR)
ADDI AC14,1 ; OPTR,1
ADDI AC12,1 ; PCNT,1
MOVE AC1,SCACOD ; AC1,SCACOD
CAIE AC1,21 ; AC1,21
CAIN AC1,17 ; AC1,17
JRST L.479 ; L.479
MOVEI AC1,P.AHN ; AC1,P.AHN
PUSHJ SP,CERROR ; SP,CERROR
L.479: MOVEI AC1,17 ; AC1,17
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.475 ; L.475
PUSHJ SP,SCAN ; SP,SCAN
MOVE AC1,CONSTP ; AC1,CONSTP
MOVEM AC1,0(AC11) ; AC1,0(LIST)
MOVE AC14,CONSTP ; OPTR,CONSTP
ADD AC14,C.9 ; OPTR,[CNSWRK]
MOVEM AC12,0(AC14) ; PCNT,0(OPTR)
MOVE AC1,CONSTP ; AC1,CONSTP
ADD AC1,AC12 ; AC1,PCNT
ADDI AC1,1 ; AC1,1
MOVEM AC1,CONSTP ; AC1,CONSTP
MOVEI AC1,-7(SP) ; IPTR,TBL
L.480: ADDI AC14,1 ; OPTR,1
MOVE AC2,0(AC1) ; AC2,0(IPTR)
MOVEM AC2,0(AC14) ; AC2,0(OPTR)
ADDI AC1,1 ; IPTR,1
SOJG AC12,L.480 ; PCNT,L.480
ADJSP SP,-10 ; SP,-10
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POPJ SP, ; SP,
; Routine Size: 54 words
; 3450
; 3451 ROUTINE CPRETN: NOVALUE = ! <Return-statement>
; 3452
; 3453 !++
; 3454 ! Functional description:
; 3455 ! Called from <Statement> to compile a Return statement.
; 3456 !
; 3457 ! Formal parameters:
; 3458 ! None
; 3459 !
; 3460 ! Implicit inputs:
; 3461 ! Source
; 3462 !
; 3463 ! Implicit outputs:
; 3464 ! Code
; 3465 !
; 3466 ! Routine value:
; 3467 ! None
; 3468 !
; 3469 ! Side effects:
; 3470 ! Scans from RETURN to unrecognized atom
; 3471 !
; 3472 !--
; 3473
; 3474 BEGIN
; 3475 EXTERNAL REGISTER Z=0;
; 3476 LOCAL
; 3477 DESC;
; 3478 SCAN();
; 3479 IF .CURCLS EQL GST_CLS_FCN
; 3480 THEN
; 3481 IF .CURTYP EQL GST_TYP_INT
; 3482 THEN
; 3483 DESC = CPIEXP(OPN_TMP_INT)
; 3484 ELSE
; 3485 DESC = CPSEXP(OPN_TMP_STR);
; 3486 GENINS(OPR_RET,.DESC,0,0)
; 3487 END;
CPRETN: PUSHJ SP,SCAN ; SP,SCAN
MOVEI AC1,3 ; AC1,3
CAME AC1,CURCLS ; AC1,CURCLS
JRST L.483 ; L.483
SKIPE CURTYP ; CURTYP
JRST L.481 ; L.481
MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
JRST L.482 ; L.482
L.481: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
L.482: MOVE AC2,AC1 ; DESC,AC1
L.483: MOVEI AC1,31 ; AC1,31
SETZB AC3,AC4 ; AC3,AC4
JRST GENINS ; GENINS
; Routine Size: 15 words
; 3488
; 3489 ROUTINE CPIEXP(DSTN) = ! <Integer-expression>
; 3490
; 3491 !++
; 3492 ! Functional description:
; 3493 ! Compiles integer expression, and generates necessary instructions
; 3494 ! to place value of expression into destination provided. Caller
; 3495 ! may require that result be placed in a particular variable; if
; 3496 ! he requires only OPN_TMP_INT then I can put it anyplace and
; 3497 ! return a read designator.
; 3498 !
; 3499 ! Formal parameters:
; 3500 ! Operand descriptor into which expression should be stored.
; 3501 !
; 3502 ! Implicit inputs:
; 3503 ! Source
; 3504 !
; 3505 ! Implicit outputs:
; 3506 ! Code
; 3507 !
; 3508 ! Routine value:
; 3509 ! Operand descriptor into which expression was stored
; 3510 !
; 3511 ! Side effects:
; 3512 ! Scans from first atom of expression past last atom
; 3513 !
; 3514 !--
; 3515
; 3516 BEGIN
; 3517 EXTERNAL REGISTER Z=0;
; 3518 LOCAL
; 3519 OPR, ! Operator
; 3520 BDESC, ! Source designator
; 3521 CDESC; ! Source designator
; 3522 CDESC = CPITRM();
; 3523 IF .CDESC LSS 0 THEN CERROR(CERM13);
; 3524 OPR = OPR_STO;
; 3525 WHILE
; 3526 .SCACOD EQL SCN_PLUS OR .SCACOD EQL SCN_MINUS
; 3527 DO
; 3528 BEGIN
; 3529 IF .OPR EQL OPR_STO
; 3530 THEN
; 3531 BDESC = .CDESC
; 3532 ELSE
; 3533 BEGIN
; 3534 GENINS(.OPR,OPN_TMP_INT,.BDESC,.CDESC);
; 3535 BDESC = OPN_TMP_INT
; 3536 END;
; 3537 OPR = (IF .SCACOD EQL SCN_PLUS THEN OPR_ADD ELSE OPR_SUB);
; 3538 SCAN();
; 3539 IF (CDESC = CPITRM()) LSS 0 THEN CERROR(CERM13)
; 3540 END;
; 3541 IF .DSTN EQL OPN_TMP_INT AND .OPR EQL OPR_STO THEN RETURN .CDESC;
; 3542 GENINS(.OPR,.DSTN,.BDESC,.CDESC);
; 3543 .DSTN
; 3544 END;
CPIEXP: PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC12,AC1 ; DSTN,AC1
PUSHJ SP,CPITRM ; SP,CPITRM
MOVE AC13,AC1 ; CDESC,AC1
JUMPGE AC13,L.484 ; CDESC,L.484
MOVEI AC1,CERM13 ; AC1,CERM13
PUSHJ SP,CERROR ; SP,CERROR
L.484: MOVEI AC14,5 ; OPR,5
L.485: MOVE AC1,SCACOD ; AC1,SCACOD
CAIN AC1,4 ; AC1,4
JRST L.486 ; L.486
CAIE AC1,5 ; AC1,5
JRST L.489 ; L.489
L.486: CAIE AC14,5 ; OPR,5
JRST L.487 ; L.487
MOVE AC11,AC13 ; BDESC,CDESC
JRST L.488 ; L.488
L.487: MOVE AC1,AC14 ; AC1,OPR
MOVEI AC2,-200000 ; AC2,-200000
MOVE AC3,AC11 ; AC3,BDESC
MOVE AC4,AC13 ; AC4,CDESC
PUSHJ SP,GENINS ; SP,GENINS
MOVEI AC11,-200000 ; BDESC,-200000
L.488: MOVEI AC1,4 ; AC1,4
CAMN AC1,SCACOD ; AC1,SCACOD
TDZA AC14,AC14 ; OPR,OPR
MOVEI AC14,1 ; OPR,1
PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPITRM ; SP,CPITRM
MOVE AC13,AC1 ; CDESC,AC1
JUMPGE AC13,L.485 ; CDESC,L.485
MOVEI AC1,CERM13 ; AC1,CERM13
PUSHJ SP,CERROR ; SP,CERROR
JRST L.485 ; L.485
L.489: CAIN AC12,-200000 ; DSTN,-200000
CAIE AC14,5 ; OPR,5
JRST L.490 ; L.490
MOVE AC1,AC13 ; AC1,CDESC
JRST L.491 ; L.491
L.490: MOVE AC1,AC14 ; AC1,OPR
MOVE AC2,AC12 ; AC2,DSTN
MOVE AC3,AC11 ; AC3,BDESC
MOVE AC4,AC13 ; AC4,CDESC
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC1,AC12 ; AC1,DSTN
L.491: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POPJ SP, ; SP,
; Routine Size: 53 words
; 3545
; 3546 ROUTINE CPSEXP(DSTN) = ! <String-expression>
; 3547
; 3548 !++
; 3549 ! Functional description:
; 3550 ! Compiles string expression, and generates necessary instructions
; 3551 ! to place value of expression into destination provided. Caller
; 3552 ! may require that result be placed in a particular variable; if
; 3553 ! he requires only OPN_TMP_STR then I can put it anyplace and
; 3554 ! return a real designator.
; 3555 !
; 3556 ! Formal parameters:
; 3557 ! Operand descriptor into which expression should be stored.
; 3558 !
; 3559 ! Implicit inputs:
; 3560 ! Source
; 3561 !
; 3562 ! Implicit outputs:
; 3563 ! Code
; 3564 !
; 3565 ! Routine value:
; 3566 ! Operand descriptor into which expression was stored
; 3567 !
; 3568 ! Side effects:
; 3569 ! Scans from first atom of expression past last atom
; 3570 !
; 3571 !--
; 3572
; 3573 BEGIN
; 3574 EXTERNAL REGISTER Z=0;
; 3575 LOCAL
; 3576 OPR, ! Operation code to be used
; 3577 BDESC, ! Designators
; 3578 CDESC;
; 3579 OPR = OPR_STS;
; 3580 CDESC = CPSPRM();
; 3581 WHILE
; 3582 .SCACOD EQL SCN_PLUS
; 3583 DO
; 3584 BEGIN
; 3585 IF .OPR EQL OPR_STS
; 3586 THEN
; 3587 BEGIN
; 3588 OPR = OPR_CNS;
; 3589 BDESC = .CDESC
; 3590 END
; 3591 ELSE
; 3592 BEGIN
; 3593 GENINS(OPR_CNS,OPN_TMP_STR,.BDESC,.CDESC);
; 3594 BDESC = OPN_TMP_STR
; 3595 END;
; 3596 SCAN();
; 3597 CDESC = CPSPRM()
; 3598 END;
; 3599 IF .DSTN EQL OPN_TMP_STR AND .OPR EQL OPR_STS THEN RETURN .CDESC;
; 3600 GENINS(.OPR,.DSTN,.BDESC,.CDESC);
; 3601 .DSTN
; 3602 END;
CPSEXP: PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC12,AC1 ; DSTN,AC1
MOVEI AC14,6 ; OPR,6
L.492: PUSHJ SP,CPSPRM ; SP,CPSPRM
MOVE AC11,AC1 ; CDESC,AC1
MOVEI AC1,4 ; AC1,4
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.495 ; L.495
CAIE AC14,6 ; OPR,6
JRST L.493 ; L.493
MOVEI AC14,4 ; OPR,4
MOVE AC13,AC11 ; BDESC,CDESC
JRST L.494 ; L.494
L.493: MOVEI AC1,4 ; AC1,4
MOVEI AC2,-100000 ; AC2,-100000
MOVE AC3,AC13 ; AC3,BDESC
MOVE AC4,AC11 ; AC4,CDESC
PUSHJ SP,GENINS ; SP,GENINS
MOVEI AC13,-100000 ; BDESC,-100000
L.494: PUSHJ SP,SCAN ; SP,SCAN
JRST L.492 ; L.492
L.495: CAIN AC12,-100000 ; DSTN,-100000
CAIE AC14,6 ; OPR,6
JRST L.496 ; L.496
MOVE AC1,AC11 ; AC1,CDESC
JRST L.497 ; L.497
L.496: MOVE AC1,AC14 ; AC1,OPR
MOVE AC2,AC12 ; AC2,DSTN
MOVE AC3,AC13 ; AC3,BDESC
MOVE AC4,AC11 ; AC4,CDESC
PUSHJ SP,GENINS ; SP,GENINS
MOVE AC1,AC12 ; AC1,DSTN
L.497: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POPJ SP, ; SP,
; Routine Size: 40 words
; 3603
; 3604 ROUTINE CPLEXP = ! <Logical-expression>
; 3605
; 3606 !++
; 3607 ! Functional description:
; 3608 ! Compiles logical expression, generating appropriate Compare
; 3609 ! instruction to apply test to the primaries (actually, generates
; 3610 ! opposite Compare instruction, so that true-statement can
; 3611 ! immediately follow the Compare). Returns index
; 3612 ! of Compare instruction.
; 3613 !
; 3614 ! Formal parameters:
; 3615 ! None
; 3616 !
; 3617 ! Implicit inputs:
; 3618 ! Source, symbol table
; 3619 !
; 3620 ! Implicit outputs:
; 3621 ! Code
; 3622 !
; 3623 ! Routine value:
; 3624 ! Index of Compare instruction
; 3625 !
; 3626 ! Side effects:
; 3627 ! Scans from first atom of expression past last atom
; 3628 !
; 3629 !--
; 3630
; 3631 BEGIN
; 3632 EXTERNAL REGISTER Z=0;
; 3633 LOCAL
; 3634 TYPE, ! Data type of comparison
; 3635 OPR, ! Operation code
; 3636 BDESC, ! B operand descriptor
; 3637 CDESC; ! C operand descriptor
; 3638 ! Must be in the same order as the relational scan codes
; 3639 BIND
; 3640 CMP_TBL_INT =
; 3641 UPLIT(OPR_BGE,OPR_BGT,OPR_BEQ,OPR_BNE,OPR_BLE,OPR_BLT): VECTOR,
; 3642 CMP_TBL_STR =
; 3643 UPLIT(OPR_CGE,OPR_CGT,OPR_CEQ,OPR_CNE,OPR_CLE,OPR_CLT): VECTOR;
; 3644 TYPE = CPCLSE();
; 3645 IF .TYPE LSS 0 THEN CERROR(CERM18);
; 3646 IF .TYPE EQL STE_TYP_INT
; 3647 THEN
; 3648 BDESC = CPIEXP(OPN_TMP_INT)
; 3649 ELSE
; 3650 BDESC = CPSEXP(OPN_TMP_STR);
; 3651 IF .SCACOD LSS SCN_1RL OR .SCACOD GTR SCN_LRL
; 3652 THEN
; 3653 ERROR('Relational missing');
; 3654 OPR = (CASE .TYPE FROM STE_TYP_INT TO STE_TYP_STR OF
; 3655 SET
; 3656 [STE_TYP_INT]: .CMP_TBL_INT[.SCACOD-SCN_LSS];
; 3657 [STE_TYP_STR]: .CMP_TBL_STR[.SCACOD-SCN_LSS]
; 3658 TES);
; 3659 SCAN();
; 3660 CDESC = (CASE .TYPE FROM STE_TYP_INT TO STE_TYP_STR OF
; 3661 SET
; 3662 [STE_TYP_INT]: CPIEXP(OPN_TMP_INT);
; 3663 [STE_TYP_STR]: CPSEXP(OPN_TMP_STR);
; 3664 TES);
; 3665 GENINS(.OPR,0,.BDESC,.CDESC)
; 3666 END;
P.AHO: EXP 13
EXP 14
EXP 11
EXP 12
EXP 7
EXP 10
P.AHP: EXP 21
EXP 22
EXP 17
EXP 20
EXP 15
EXP 16
P.AHQ: BYTE (7)"R","e","l","a","t" ; Relat
BYTE (7)"i","o","n","a","l" ; ional
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
CMP_TBL_INT= P.AHO
CMP_TBL_STR= P.AHP
CPLEXP: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
PUSHJ SP,CPCLSE ; SP,CPCLSE
MOVE AC14,AC1 ; TYPE,AC1
JUMPGE AC14,L.498 ; TYPE,L.498
MOVEI AC1,CERM18 ; AC1,CERM18
PUSHJ SP,CERROR ; SP,CERROR
L.498: JUMPN AC14,L.499 ; TYPE,L.499
MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
JRST L.500 ; L.500
L.499: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
L.500: MOVE AC12,AC1 ; BDESC,AC1
MOVE AC1,SCACOD ; AC1,SCACOD
CAIGE AC1,10 ; AC1,10
JRST L.501 ; L.501
CAIG AC1,15 ; AC1,15
JRST L.502 ; L.502
L.501: MOVEI AC1,P.AHQ ; AC1,P.AHQ
PUSHJ SP,CERROR ; SP,CERROR
L.502: MOVE AC1,SCACOD ; AC1,SCACOD
SUBI AC1,10 ; AC1,10
JRST L.503(AC14) ; L.503(TYPE)
L.503: JRST L.504 ; L.504
JRST L.505 ; L.505
L.504: SKIPA AC13,CMP_TBL_INT(AC1) ; OPR,CMP_TBL_INT(AC1)
L.505: MOVE AC13,CMP_TBL_STR(AC1) ; OPR,CMP_TBL_STR(AC1)
PUSHJ SP,SCAN ; SP,SCAN
JRST L.506(AC14) ; L.506(TYPE)
L.506: JRST L.507 ; L.507
JRST L.508 ; L.508
L.507: MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
JRST L.509 ; L.509
L.508: MOVEI AC1,-100000 ; AC1,-100000
PUSHJ SP,CPSEXP ; SP,CPSEXP
L.509: MOVE AC4,AC1 ; CDESC,AC1
MOVE AC1,AC13 ; AC1,OPR
SETZ AC2, ; AC2,
MOVE AC3,AC12 ; AC3,BDESC
PUSHJ SP,GENINS ; SP,GENINS
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 47 words
; 3667
; 3668 ROUTINE CPITRM = ! <Integer-term>
; 3669
; 3670 !++
; 3671 ! Functional description:
; 3672 ! Compile an integer term, returning a source operand descriptor.
; 3673 !
; 3674 ! Formal parameters:
; 3675 ! None
; 3676 !
; 3677 ! Implicit inputs:
; 3678 ! Source
; 3679 !
; 3680 ! Implicit outputs:
; 3681 ! Code
; 3682 !
; 3683 ! Routine value:
; 3684 ! Operand descriptor, or -1 if not an integer
; 3685 !
; 3686 ! Side effects:
; 3687 ! Scans past term
; 3688 !
; 3689 !--
; 3690
; 3691 BEGIN
; 3692 EXTERNAL REGISTER Z=0;
; 3693 LOCAL
; 3694 OPR, ! Operator
; 3695 BDESC, ! Source designators
; 3696 CDESC;
; 3697 IF (BDESC = CPIPRM()) LSS 0 THEN RETURN -1;
; 3698 OPR = OPR_STO;
; 3699 WHILE
; 3700 .SCACOD EQL SCN_TIMES OR .SCACOD EQL SCN_DIV
; 3701 DO
; 3702 BEGIN
; 3703 OPR = (IF .SCACOD EQL SCN_TIMES THEN OPR_MUL ELSE OPR_DIV);
; 3704 SCAN();
; 3705 IF (CDESC = CPIPRM()) LSS 0 THEN CERROR(CERM13);
; 3706 GENINS(.OPR,OPN_TMP_INT,.BDESC,.CDESC);
; 3707 BDESC = OPN_TMP_INT
; 3708 END;
; 3709 .BDESC
; 3710 END;
CPITRM: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
PUSHJ SP,CPIPRM ; SP,CPIPRM
MOVE AC13,AC1 ; BDESC,AC1
JUMPGE AC13,L.510 ; BDESC,L.510
SETO AC1, ; AC1,
JRST L.518 ; L.518
L.510: MOVEI AC14,5 ; OPR,5
L.511: MOVE AC1,SCACOD ; AC1,SCACOD
SETZ AC2, ; AC2,
CAIE AC1,6 ; AC1,6
JRST L.512 ; L.512
MOVEI AC2,1 ; AC2,1
JRST L.513 ; L.513
L.512: CAIE AC1,7 ; AC1,7
JRST L.517 ; L.517
L.513: TRNN AC2,1 ; AC2,1
JRST L.514 ; L.514
MOVEI AC14,2 ; OPR,2
JRST L.515 ; L.515
L.514: MOVEI AC14,3 ; OPR,3
L.515: PUSHJ SP,SCAN ; SP,SCAN
PUSHJ SP,CPIPRM ; SP,CPIPRM
MOVE AC12,AC1 ; CDESC,AC1
JUMPGE AC12,L.516 ; CDESC,L.516
MOVEI AC1,CERM13 ; AC1,CERM13
PUSHJ SP,CERROR ; SP,CERROR
L.516: MOVE AC1,AC14 ; AC1,OPR
MOVEI AC2,-200000 ; AC2,-200000
MOVE AC3,AC13 ; AC3,BDESC
MOVE AC4,AC12 ; AC4,CDESC
PUSHJ SP,GENINS ; SP,GENINS
MOVEI AC13,-200000 ; BDESC,-200000
JRST L.511 ; L.511
L.517: MOVE AC1,AC13 ; AC1,BDESC
L.518: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 40 words
; 3711
; 3712 ROUTINE CPIPRM = ! <Integer-primary>
; 3713
; 3714 !++
; 3715 ! Functional description:
; 3716 ! Processes an integer primary from the source stream, either
; 3717 ! an integer identifier, an integer system variable, an integer
; 3718 ! constant, or a temporary designator for the results of a function
; 3719 ! invocation. Returns a suitable source operand descriptor.
; 3720 !
; 3721 ! Formal parameters:
; 3722 ! None
; 3723 !
; 3724 ! Implicit inputs:
; 3725 ! Source, symbols
; 3726 !
; 3727 ! Implicit outputs:
; 3728 ! Constants
; 3729 !
; 3730 ! Routine value:
; 3731 ! Operand descriptor, or -1 if not recognized
; 3732 !
; 3733 ! Side effects:
; 3734 ! Scans past end of primary
; 3735 !
; 3736 !--
; 3737
; 3738 BEGIN
; 3739 EXTERNAL REGISTER Z=0;
; 3740 LOCAL
; 3741 DESC; ! Value to be constructed
; 3742 IF .SCACOD EQL SCN_IDENT
; 3743 THEN
; 3744 BEGIN
; 3745 DESC = FNDSMB(-1,STE_TYP_INT);
; 3746 IF .DESC LSS 0 THEN RETURN -1;
; 3747 IF .SYMWRK[.DESC,STE_CLS] EQL STE_CLS_PRC THEN RETURN -1;
; 3748 IF .SYMWRK[.DESC,STE_CLS] EQL STE_CLS_FCN
; 3749 THEN
; 3750 BEGIN
; 3751 LOCAL
; 3752 PLIST; ! Actual argument list pointer
; 3753 PLIST = -1;
; 3754 IF SCAN() EQL SCN_LPAREN THEN CPACTL(PLIST);
; 3755 GENINS(OPR_CAL,.DESC,.PLIST,OPN_TMP_INT);
; 3756 DESC = OPN_TMP_INT
; 3757 END
; 3758 ELSE
; 3759 SCAN()
; 3760 END
; 3761 ELSE
; 3762 IF .SCACOD EQL SCN_SYSNAME
; 3763 THEN
; 3764 BEGIN
; 3765 IF .PSDEFN[.SCATOM,SYN_CLS] EQL SYN_CLS_VAR
; 3766 THEN
; 3767 IF .PSDEFN[.SCATOM,SYN_TYP] EQL SYN_TYP_INT
; 3768 THEN
; 3769 BEGIN
; 3770 MAP DESC: OPRAND;
; 3771 DESC[OPN_ADR] = .SCATOM;
; 3772 DESC[OPN_CLS] = OPN_CLS_SYN;
; 3773 SCAN()
; 3774 END
; 3775 ELSE
; 3776 RETURN -1
; 3777 ELSE
; 3778 IF .PSDEFN[.SCATOM,SYN_CLS] NEQ SYN_CLS_FCN
; 3779 THEN
; 3780 RETURN -1
; 3781 ELSE
; 3782 IF .PSDEFN[.SCATOM,SYN_TYP] EQL SYN_TYP_INT
; 3783 THEN
; 3784 BEGIN
; 3785 LOCAL
; 3786 PLIST; ! Actual argument list pointer
; 3787 BEGIN
; 3788 MAP DESC: OPRAND;
; 3789 DESC[OPN_ADR] = .SCATOM;
; 3790 DESC[OPN_CLS] = OPN_CLS_SYN
; 3791 END;
; 3792 PLIST = -1;
; 3793 IF SCAN() EQL SCN_LPAREN THEN CPACTL(PLIST);
; 3794 GENINS(OPR_CAL,.DESC,.PLIST,OPN_TMP_INT);
; 3795 DESC = OPN_TMP_INT
; 3796 END
; 3797 ELSE
; 3798 RETURN -1
; 3799 END
; 3800 ELSE
; 3801 IF .SCACOD EQL SCN_LPAREN
; 3802 THEN
; 3803 BEGIN
; 3804 SCAN();
; 3805 DESC = CPIEXP(OPN_TMP_INT);
; 3806 IF .SCACOD NEQ SCN_RPAREN THEN CERROR(CERM14);
; 3807 SCAN()
; 3808 END
; 3809 ELSE
; 3810 IF .SCACOD EQL SCN_MINUS
; 3811 THEN
; 3812 BEGIN
; 3813 MAP DESC: OPRAND;
; 3814 IF SCAN() NEQ SCN_NUMB THEN ERROR('Unary minus only for constants');
; 3815 DESC[OPN_ADR] = GETCNS(-.SCANUM,STE_TYP_INT);
; 3816 DESC[OPN_CLS] = OPN_CLS_CNS;
; 3817 DESC[OPN_STR] = 0;
; 3818 SCAN()
; 3819 END
; 3820 ELSE
; 3821 BEGIN
; 3822 MAP DESC: OPRAND;
; 3823 IF .SCACOD NEQ SCN_NUMB THEN RETURN -1;
; 3824 DESC[OPN_ADR] = GETCNS(.SCANUM,STE_TYP_INT);
; 3825 DESC[OPN_CLS] = OPN_CLS_CNS;
; 3826 DESC[OPN_STR] = 0;
; 3827 SCAN()
; 3828 END;
; 3829 .DESC
; 3830 END;
P.AHR: BYTE (7)"U","n","a","r","y" ; Unary
BYTE (7)" ","m","i","n","u" ; minu
BYTE (7)"s"," ","o","n","l" ; s onl
BYTE (7)"y"," ","f","o","r" ; y for
BYTE (7)" ","c","o","n","s" ; cons
BYTE (7)"t","a","n","t","s" ; tants
BYTE (7)000,000,000,000,000
CPIPRM: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,2 ; SP,2
MOVE AC14,SCACOD ; AC14,SCACOD
CAIE AC14,1 ; AC14,1
JRST L.520 ; L.520
SETO AC1, ; AC1,
SETZ AC2, ; AC2,
PUSHJ SP,FNDSMB ; SP,FNDSMB
MOVE AC13,AC1 ; DESC,AC1
JUMPL AC13,L.529 ; DESC,L.529
MOVE AC1,AC13 ; AC1,DESC
IMULI AC1,2 ; AC1,2
LDB AC1,C.27 ; AC1,[POINT 3,SYMWRK(AC1),5] <30,3>
CAIN AC1,3 ; AC1,3
JRST L.529 ; L.529
CAIE AC1,4 ; AC1,4
JRST L.525 ; L.525
SETOM -1(SP) ; PLIST
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,16 ; AC1,16
JRST L.519 ; L.519
MOVEI AC1,-1(SP) ; AC1,PLIST
PUSHJ SP,CPACTL ; SP,CPACTL
L.519: MOVEI AC1,23 ; AC1,23
MOVE AC2,AC13 ; AC2,DESC
MOVE AC3,-1(SP) ; AC3,PLIST
JRST L.523 ; L.523
L.520: CAIE AC14,112 ; AC14,112
JRST L.524 ; L.524
MOVE AC1,SCATOM ; AC1,SCATOM
IMULI AC1,2 ; AC1,2
LDB AC2,C.31 ; AC2,[POINT 3,PSDEFN(AC1),17] <18,3>
CAIE AC2,2 ; AC2,2
JRST L.521 ; L.521
LDB AC2,C.33 ; AC2,[POINT 3,PSDEFN(AC1),14] <21,3>
JUMPN AC2,L.529 ; AC2,L.529
MOVE AC1,SCATOM ; AC1,SCATOM
DPB AC1,C.32 ; AC1,[POINT 15,AC13,35] <0,15>
TRZ AC13,-200000 ; DESC,-200000
TRO AC13,200000 ; DESC,200000
JRST L.525 ; L.525
L.521: CAIE AC2,1 ; AC2,1
JRST L.529 ; L.529
LDB AC2,C.33 ; AC2,[POINT 3,PSDEFN(AC1),14] <21,3>
JUMPN AC2,L.529 ; AC2,L.529
MOVE AC1,SCATOM ; AC1,SCATOM
DPB AC1,C.32 ; AC1,[POINT 15,AC13,35] <0,15>
TRZ AC13,-200000 ; DESC,-200000
TRO AC13,200000 ; DESC,200000
SETOM 0(SP) ; PLIST
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,16 ; AC1,16
JRST L.522 ; L.522
MOVEI AC1,0(SP) ; AC1,PLIST
PUSHJ SP,CPACTL ; SP,CPACTL
L.522: MOVEI AC1,23 ; AC1,23
MOVE AC2,AC13 ; AC2,DESC
MOVE AC3,0(SP) ; AC3,PLIST
L.523: MOVEI AC4,-200000 ; AC4,-200000
PUSHJ SP,GENINS ; SP,GENINS
MOVEI AC13,-200000 ; DESC,-200000
JRST L.532 ; L.532
L.524: CAIE AC14,16 ; AC14,16
JRST L.526 ; L.526
PUSHJ SP,SCAN ; SP,SCAN
MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
MOVE AC13,AC1 ; DESC,AC1
MOVEI AC1,17 ; AC1,17
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.525 ; L.525
MOVEI AC1,CERM14 ; AC1,CERM14
PUSHJ SP,CERROR ; SP,CERROR
L.525: PUSHJ SP,SCAN ; SP,SCAN
JRST L.532 ; L.532
L.526: CAIE AC14,5 ; AC14,5
JRST L.528 ; L.528
PUSHJ SP,SCAN ; SP,SCAN
CAIN AC1,2 ; AC1,2
JRST L.527 ; L.527
MOVEI AC1,P.AHR ; AC1,P.AHR
PUSHJ SP,CERROR ; SP,CERROR
L.527: MOVN AC1,SCANUM ; AC1,SCANUM
JRST L.531 ; L.531
L.528: CAIN AC14,2 ; AC14,2
JRST L.530 ; L.530
L.529: SETO AC1, ; AC1,
JRST L.533 ; L.533
L.530: MOVE AC1,SCANUM ; AC1,SCANUM
L.531: SETZ AC2, ; AC2,
PUSHJ SP,GETCNS ; SP,GETCNS
DPB AC1,C.32 ; AC1,[POINT 15,AC13,35] <0,15>
TRZ AC13,-200000 ; DESC,-200000
TRO AC13,400000 ; DESC,400000
PUSHJ SP,SCAN ; SP,SCAN
TRZ AC13,100000 ; DESC,100000
L.532: MOVE AC1,AC13 ; AC1,DESC
L.533: ADJSP SP,-2 ; SP,-2
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 102 words
; 3831
; 3832 ROUTINE CPSPRM = ! <String-primary>
; 3833
; 3834 !++
; 3835 ! Functional description:
; 3836 ! Processes a string primary from the source stream, either
; 3837 ! a string identifier, a string system variable, a string
; 3838 ! constant, or a call to a string-valued function. If necessary,
; 3839 ! generates instructions to calculate value, storing it in a
; 3840 ! stack temporary. Returns a suitable source operand descriptor.
; 3841 !
; 3842 ! Formal parameters:
; 3843 ! None
; 3844 !
; 3845 ! Implicit inputs:
; 3846 ! Source, symbols
; 3847 !
; 3848 ! Implicit outputs:
; 3849 ! Constants
; 3850 !
; 3851 ! Routine value:
; 3852 ! Operand descriptor
; 3853 !
; 3854 ! Side effects:
; 3855 ! Scans past end of primary
; 3856 !
; 3857 !--
; 3858
; 3859 BEGIN
; 3860 EXTERNAL REGISTER Z=0;
; 3861 LOCAL
; 3862 DESC; ! Value to be constructed
; 3863 IF .SCACOD EQL SCN_IDENT
; 3864 THEN
; 3865 BEGIN
; 3866 DESC = FNDSMB(-1,STE_TYP_STR);
; 3867 IF .DESC EQL -1 THEN ERROR('Undefined name');
; 3868 IF .DESC EQL -2 THEN CERROR(CERM24);
; 3869 IF .SYMWRK[.DESC,STE_CLS] EQL STE_CLS_PRC
; 3870 THEN
; 3871 ERROR('Procedure name illegal');
; 3872 IF .SYMWRK[.DESC,STE_CLS] EQL STE_CLS_FCN
; 3873 THEN
; 3874 BEGIN
; 3875 LOCAL
; 3876 PLIST; ! Actual argument list pointer
; 3877 PLIST = -1;
; 3878 IF SCAN() EQL SCN_LPAREN THEN CPACTL(PLIST);
; 3879 GENINS(OPR_CAL,.DESC,.PLIST,OPN_TMP_STR);
; 3880 DESC = OPN_TMP_STR
; 3881 END
; 3882 ELSE
; 3883 SCAN()
; 3884 END
; 3885 ELSE
; 3886 IF .SCACOD EQL SCN_SYSNAME
; 3887 THEN
; 3888 BEGIN
; 3889 IF .PSDEFN[.SCATOM,SYN_CLS] EQL SYN_CLS_VAR
; 3890 THEN
; 3891 IF .PSDEFN[.SCATOM,SYN_TYP] EQL SYN_TYP_STR
; 3892 THEN
; 3893 BEGIN
; 3894 MAP DESC: OPRAND;
; 3895 DESC[OPN_ADR] = .SCATOM;
; 3896 DESC[OPN_CLS] = OPN_CLS_SYN;
; 3897 SCAN()
; 3898 END
; 3899 ELSE
; 3900 CERROR(CERM24)
; 3901 ELSE
; 3902 IF .PSDEFN[.SCATOM,SYN_CLS] EQL SYN_CLS_FCN
; 3903 THEN
; 3904 IF .PSDEFN[.SCATOM,SYN_TYP] EQL SYN_TYP_STR
; 3905 THEN
; 3906 BEGIN
; 3907 LOCAL
; 3908 PLIST; ! Actual argument list pointer
; 3909 BEGIN
; 3910 MAP DESC: OPRAND;
; 3911 DESC = .SCATOM;
; 3912 DESC[OPN_CLS] = OPN_CLS_SYN
; 3913 END;
; 3914 PLIST = -1;
; 3915 IF SCAN() EQL SCN_LPAREN THEN CPACTL(PLIST);
; 3916 GENINS(OPR_CAL,.DESC,.PLIST,OPN_TMP_STR);
; 3917 DESC = OPN_TMP_STR
; 3918 END
; 3919 ELSE
; 3920 ERROR('Not a string procedure or variable')
; 3921 ELSE
; 3922 ERROR('Not a string procedure or variable')
; 3923 END
; 3924 ELSE
; 3925 BEGIN
; 3926 LOCAL SPTR:STR_VAL;
; 3927 MAP DESC: OPRAND;
; 3928 IF .SCACOD NEQ SCN_QSTRING
; 3929 THEN
; 3930 CERROR(CERM24);
; 3931 SPTR[STV_LEN] = .SCALEN;
; 3932 SPTR[STV_ADR] = SCATOM[0];
; 3933 DESC[OPN_ADR] = GETCNS(.SPTR,STE_TYP_STR);
; 3934 DESC[OPN_CLS] = OPN_CLS_CNS;
; 3935 DESC[OPN_STR] = 1;
; 3936 SCAN()
; 3937 END;
; 3938 IF .SCACOD EQL SCN_LBRKT
; 3939 THEN
; 3940 BEGIN
; 3941 LOCAL
; 3942 ARGL, ! Argument descriptors
; 3943 ARGR;
; 3944 SCAN();
; 3945 IF (ARGL = CPIEXP(OPN_TMP_INT)) LSS 0
; 3946 THEN
; 3947 ERROR('Start position missing');
; 3948 IF .SCACOD NEQ SCN_COLON THEN CERROR(CERM11);
; 3949 IF SCAN() EQL SCN_TIMES
; 3950 THEN
; 3951 BEGIN
; 3952 ARGR = -1;
; 3953 SCAN()
; 3954 END
; 3955 ELSE
; 3956 IF (ARGR = CPIEXP(OPN_TMP_INT)) LSS 0 THEN ERROR('Count missing');
; 3957 IF .SCACOD NEQ SCN_RBRKT THEN CERROR(CERM23);
; 3958 SCAN();
; 3959 IF .CONSTP+2 GEQ CNSWKL THEN CERROR(CERM1);
; 3960 CNSWRK[.CONSTP] = .ARGL;
; 3961 CNSWRK[.CONSTP+1] = .ARGR;
; 3962 GENINS(OPR_SBS,OPN_TMP_STR,.CONSTP,.DESC);
; 3963 CONSTP = .CONSTP + 2;
; 3964 DESC = OPN_TMP_STR
; 3965 END;
; 3966 .DESC
; 3967 END;
P.AHS: BYTE (7)"U","n","d","e","f" ; Undef
BYTE (7)"i","n","e","d"," " ; ined
BYTE (7)"n","a","m","e",000 ; name
P.AHT: BYTE (7)"P","r","o","c","e" ; Proce
BYTE (7)"d","u","r","e"," " ; dure
BYTE (7)"n","a","m","e"," " ; name
BYTE (7)"i","l","l","e","g" ; illeg
BYTE (7)"a","l",000,000,000 ; al
P.AHU: BYTE (7)"N","o","t"," ","a" ; Not a
BYTE (7)" ","s","t","r","i" ; stri
BYTE (7)"n","g"," ","p","r" ; ng pr
BYTE (7)"o","c","e","d","u" ; ocedu
BYTE (7)"r","e"," ","o","r" ; re or
BYTE (7)" ","v","a","r","i" ; vari
BYTE (7)"a","b","l","e",000 ; able
P.AHV: BYTE (7)"N","o","t"," ","a" ; Not a
BYTE (7)" ","s","t","r","i" ; stri
BYTE (7)"n","g"," ","p","r" ; ng pr
BYTE (7)"o","c","e","d","u" ; ocedu
BYTE (7)"r","e"," ","o","r" ; re or
BYTE (7)" ","v","a","r","i" ; vari
BYTE (7)"a","b","l","e",000 ; able
P.AHW: BYTE (7)"S","t","a","r","t" ; Start
BYTE (7)" ","p","o","s","i" ; posi
BYTE (7)"t","i","o","n"," " ; tion
BYTE (7)"m","i","s","s","i" ; missi
BYTE (7)"n","g",000,000,000 ; ng
P.AHX: BYTE (7)"C","o","u","n","t" ; Count
BYTE (7)" ","m","i","s","s" ; miss
BYTE (7)"i","n","g",000,000 ; ing
CPSPRM: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,2 ; SP,2
MOVE AC14,SCACOD ; AC14,SCACOD
CAIE AC14,1 ; AC14,1
JRST L.538 ; L.538
SETO AC1, ; AC1,
MOVEI AC2,1 ; AC2,1
PUSHJ SP,FNDSMB ; SP,FNDSMB
MOVE AC13,AC1 ; DESC,AC1
CAME AC13,C.45 ; DESC,[-1]
JRST L.534 ; L.534
MOVEI AC1,P.AHS ; AC1,P.AHS
PUSHJ SP,CERROR ; SP,CERROR
L.534: CAME AC13,C.46 ; DESC,[-2]
JRST L.535 ; L.535
MOVEI AC1,CERM24 ; AC1,CERM24
PUSHJ SP,CERROR ; SP,CERROR
L.535: MOVE AC14,AC13 ; AC14,DESC
IMULI AC14,2 ; AC14,2
LDB AC1,C.29 ; AC1,[POINT 3,SYMWRK(AC14),5] <30,3>
CAIE AC1,3 ; AC1,3
JRST L.536 ; L.536
MOVEI AC1,P.AHT ; AC1,P.AHT
PUSHJ SP,CERROR ; SP,CERROR
L.536: LDB AC1,C.29 ; AC1,[POINT 3,SYMWRK(AC14),5] <30,3>
CAIE AC1,4 ; AC1,4
JRST L.548 ; L.548
SETOM -1(SP) ; PLIST
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,16 ; AC1,16
JRST L.537 ; L.537
MOVEI AC1,-1(SP) ; AC1,PLIST
PUSHJ SP,CPACTL ; SP,CPACTL
L.537: MOVEI AC1,23 ; AC1,23
MOVE AC2,AC13 ; AC2,DESC
MOVE AC3,-1(SP) ; AC3,PLIST
JRST L.542 ; L.542
L.538: CAIE AC14,112 ; AC14,112
JRST L.546 ; L.546
MOVE AC2,SCATOM ; AC2,SCATOM
IMULI AC2,2 ; AC2,2
LDB AC1,C.43 ; AC1,[POINT 3,PSDEFN(AC2),17] <18,3>
CAIE AC1,2 ; AC1,2
JRST L.540 ; L.540
LDB AC1,C.44 ; AC1,[POINT 3,PSDEFN(AC2),14] <21,3>
CAIE AC1,1 ; AC1,1
JRST L.539 ; L.539
MOVE AC1,SCATOM ; AC1,SCATOM
DPB AC1,C.32 ; AC1,[POINT 15,AC13,35] <0,15>
TRZ AC13,-200000 ; DESC,-200000
TRO AC13,200000 ; DESC,200000
JRST L.548 ; L.548
L.539: MOVEI AC1,CERM24 ; AC1,CERM24
JRST L.545 ; L.545
L.540: CAIE AC1,1 ; AC1,1
JRST L.544 ; L.544
LDB AC1,C.44 ; AC1,[POINT 3,PSDEFN(AC2),14] <21,3>
CAIE AC1,1 ; AC1,1
JRST L.543 ; L.543
MOVE AC13,SCATOM ; DESC,SCATOM
TRZ AC13,-200000 ; DESC,-200000
TRO AC13,200000 ; DESC,200000
SETOM 0(SP) ; PLIST
PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,16 ; AC1,16
JRST L.541 ; L.541
MOVEI AC1,0(SP) ; AC1,PLIST
PUSHJ SP,CPACTL ; SP,CPACTL
L.541: MOVEI AC1,23 ; AC1,23
MOVE AC2,AC13 ; AC2,DESC
MOVE AC3,0(SP) ; AC3,PLIST
L.542: MOVEI AC4,-100000 ; AC4,-100000
PUSHJ SP,GENINS ; SP,GENINS
MOVEI AC13,-100000 ; DESC,-100000
JRST L.549 ; L.549
L.543: MOVEI AC1,P.AHU ; AC1,P.AHU
JRST L.545 ; L.545
L.544: MOVEI AC1,P.AHV ; AC1,P.AHV
L.545: PUSHJ SP,CERROR ; SP,CERROR
JRST L.549 ; L.549
L.546: CAIN AC14,3 ; AC14,3
JRST L.547 ; L.547
MOVEI AC1,CERM24 ; AC1,CERM24
PUSHJ SP,CERROR ; SP,CERROR
L.547: HRL AC1,SCALEN ; SPTR,SCALEN
HRR AC1,C.3 ; SPTR,[SCATOM]
MOVEI AC2,1 ; AC2,1
PUSHJ SP,GETCNS ; SP,GETCNS
DPB AC1,C.32 ; AC1,[POINT 15,AC13,35] <0,15>
TRZ AC13,-200000 ; DESC,-200000
TRO AC13,400000 ; DESC,400000
TRO AC13,100000 ; DESC,100000
L.548: PUSHJ SP,SCAN ; SP,SCAN
L.549: MOVEI AC1,23 ; AC1,23
CAME AC1,SCACOD ; AC1,SCACOD
JRST L.556 ; L.556
PUSHJ SP,SCAN ; SP,SCAN
MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
MOVE AC12,AC1 ; ARGL,AC1
JUMPGE AC12,L.550 ; ARGL,L.550
MOVEI AC1,P.AHW ; AC1,P.AHW
PUSHJ SP,CERROR ; SP,CERROR
L.550: MOVEI AC1,22 ; AC1,22
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.551 ; L.551
MOVEI AC1,CERM11 ; AC1,CERM11
PUSHJ SP,CERROR ; SP,CERROR
L.551: PUSHJ SP,SCAN ; SP,SCAN
CAIE AC1,6 ; AC1,6
JRST L.552 ; L.552
SETO AC14, ; ARGR,
PUSHJ SP,SCAN ; SP,SCAN
JRST L.553 ; L.553
L.552: MOVEI AC1,-200000 ; AC1,-200000
PUSHJ SP,CPIEXP ; SP,CPIEXP
MOVE AC14,AC1 ; ARGR,AC1
JUMPGE AC14,L.553 ; ARGR,L.553
MOVEI AC1,P.AHX ; AC1,P.AHX
PUSHJ SP,CERROR ; SP,CERROR
L.553: MOVEI AC1,24 ; AC1,24
CAMN AC1,SCACOD ; AC1,SCACOD
JRST L.554 ; L.554
MOVEI AC1,CERM23 ; AC1,CERM23
PUSHJ SP,CERROR ; SP,CERROR
L.554: PUSHJ SP,SCAN ; SP,SCAN
MOVE AC1,CONSTP ; AC1,CONSTP
ADDI AC1,2 ; AC1,2
CAIGE AC1,6000 ; AC1,6000
JRST L.555 ; L.555
MOVEI AC1,CERM1 ; AC1,CERM1
PUSHJ SP,CERROR ; SP,CERROR
L.555: MOVE AC1,CONSTP ; AC1,CONSTP
MOVEM AC12,CNSWRK(AC1) ; ARGL,CNSWRK(AC1)
MOVE AC1,CONSTP ; AC1,CONSTP
MOVEM AC14,CNSWRK+1(AC1) ; ARGR,CNSWRK+1(AC1)
MOVEI AC1,26 ; AC1,26
MOVEI AC2,-100000 ; AC2,-100000
MOVE AC3,CONSTP ; AC3,CONSTP
MOVE AC4,AC13 ; AC4,DESC
PUSHJ SP,GENINS ; SP,GENINS
MOVEI AC1,2 ; AC1,2
ADDM AC1,CONSTP ; AC1,CONSTP
MOVEI AC13,-100000 ; DESC,-100000
L.556: MOVE AC1,AC13 ; AC1,DESC
ADJSP SP,-2 ; SP,-2
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.43: POINT 3,PSDEFN(AC2),17 ; 3,PSDEFN(AC2),17
C.44: POINT 3,PSDEFN(AC2),14 ; 3,PSDEFN(AC2),14
C.45: EXP -1 ; -1
C.46: EXP -2 ; -2
; Routine Size: 156 words
; 3968
; 3969 ROUTINE CPCLSE = ! Classify expression
; 3970
; 3971 !++
; 3972 ! Functional description:
; 3973 ! Examines current atom in an attempt to classify the expression.
; 3974 ! Returns STE_TYP_INT, STE_TYP_STR, or -1 if it can't tell.
; 3975 !
; 3976 ! Formal parameters:
; 3977 ! None
; 3978 !
; 3979 ! Implicit inputs:
; 3980 ! Source
; 3981 !
; 3982 ! Implicit outputs:
; 3983 ! None
; 3984 !
; 3985 ! Routine value:
; 3986 ! STE_TYP_INT, STE_TYP_STR, or -1
; 3987 !
; 3988 ! Side effects:
; 3989 ! None
; 3990 !
; 3991 !--
; 3992
; 3993 IF .SCACOD EQL SCN_IDENT
; 3994 THEN
; 3995 BEGIN
; 3996 EXTERNAL REGISTER Z=0;
; 3997 LOCAL
; 3998 STE;
; 3999 STE = FNDSMB(-1,-1);
; 4000 IF .STE LSS 0 THEN RETURN -1;
; 4001 IF .SYMWRK[.STE,STE_CLS] EQL STE_CLS_PRC THEN RETURN -1;
; 4002 .SYMWRK[.STE,STE_TYP]
; 4003 END
; 4004 ELSE
; 4005 IF .SCACOD EQL SCN_NUMB
; 4006 THEN
; 4007 STE_TYP_INT
; 4008 ELSE
; 4009 IF .SCACOD EQL SCN_MINUS
; 4010 THEN
; 4011 STE_TYP_INT
; 4012 ELSE
; 4013 IF .SCACOD EQL SCN_QSTRING
; 4014 THEN
; 4015 STE_TYP_STR
; 4016 ELSE
; 4017 IF .SCACOD EQL SCN_SYSNAME
; 4018 THEN
; 4019 CASE .PSDEFN[.SCATOM,SYN_CLS] FROM SYN_CLS_PRC TO SYN_CLS_VAR OF
; 4020 SET
; 4021 [SYN_CLS_PRC]: -1;
; 4022 [SYN_CLS_FCN,
; 4023 SYN_CLS_VAR]: .PSDEFN[.SCATOM,SYN_TYP]
; 4024 TES
; 4025 ELSE
; 4026 -1;
CPCLSE: PUSH SP,AC14 ; SP,AC14
MOVE AC14,SCACOD ; AC14,SCACOD
CAIE AC14,1 ; AC14,1
JRST L.557 ; L.557
SETOB AC1,AC2 ; AC1,AC2
PUSHJ SP,FNDSMB ; SP,FNDSMB
JUMPL AC1,L.563 ; STE,L.563
IMULI AC1,2 ; STE,2
LDB AC2,C.27 ; AC2,[POINT 3,SYMWRK(AC1),5] <30,3>
CAIN AC2,3 ; AC2,3
JRST L.563 ; L.563
LDB AC1,C.28 ; AC1,[POINT 1,SYMWRK(AC1),6] <29,1>
JRST L.564 ; L.564
L.557: CAIN AC14,2 ; AC14,2
JRST L.558 ; L.558
CAIE AC14,5 ; AC14,5
JRST L.559 ; L.559
L.558: SETZ AC1, ; AC1,
JRST L.564 ; L.564
L.559: CAIE AC14,3 ; AC14,3
JRST L.560 ; L.560
MOVEI AC1,1 ; AC1,1
JRST L.564 ; L.564
L.560: CAIE AC14,112 ; AC14,112
JRST L.563 ; L.563
MOVE AC1,SCATOM ; AC1,SCATOM
IMULI AC1,2 ; AC1,2
LDB AC2,C.31 ; AC2,[POINT 3,PSDEFN(AC1),17] <18,3>
JRST L.561(AC2) ; L.561(AC2)
L.561: JRST L.563 ; L.563
JRST L.562 ; L.562
JRST L.562 ; L.562
L.562: LDB AC1,C.33 ; AC1,[POINT 3,PSDEFN(AC1),14] <21,3>
JRST L.564 ; L.564
L.563: SETO AC1, ; AC1,
L.564: POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 37 words
; 4027 END
; 4028 ELUDOM
END
; Low segment length: 1 word
; High segment length: 4431 words
; LIBRARY STATISTICS
;
; -------- Symbols -------- Blocks
; File Total Loaded Percent Read
;
; PK:<PA0B>EXECPD.L36.9 306 240 78 0
; PS:<BLISS>TENDEF.L36.5 56 6 10 0
; PS:<BLISS>MONSYM.L36.10 4077 54 1 0
; Information: 0
; Warnings: 3
; Errors: 0
; Compilation Complete
END