Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/execpx.lst
There are no other files named execpx.lst in the archive.
;712 CMU PCL 5(100) release version
; 0001 !<5.1.EXEC>EXECPX.B36.5, 15-Nov-82 02:39:52, Edit by PA0B
; 0002 !Allow integer arguments to DISPLAY, Add OUTRANGE to CASE
; 0003 !Try to fix up some of the problems with the PCL stack handling
; 0004 !(in particular, don't destroy stack when a procedure does a
; 0005 !DOCOMMAND of a user-defined command):
; 0006 ! - Use PCLSTF only to determine if PCL is initialized (it used
; 0007 ! to be used to keep track of free space on the stack, but it
; 0008 ! was incorrectly initialized and then not updated properly
; 0009 ! anyway).
; 0010 ! - Use STKP where PCLSTF was used to find info about the PCL
; 0011 ! stack.
; 0012 ! - Move PCIRUN here from EXECPI.
; 0013 ! - Check for PCL stack overflow/underflow in more places.
; 0014 !<5.1.EXEC>EXECPX.B36.4, 8-Nov-82 03:39:07, Edit by PA0B
; 0015 !Move the call to CLRINV at the end of the executor to be
; 0016 !before the call to be before PCICLP. This was necessary
; 0017 !because PCICLP zeroes PCCURC[ECB_CFK].
; 0018 !<5.1.EXEC>EXECPX.B36.3, 9-Sep-82 23:40:00, Edit by PA0B
; 0019 !Add FK%INV (fork is INVOKE'd) flag to fork table
; 0020 !<5.1.EXEC>EXECPX.B36.2, 4-Aug-82 23:34:29, Edit by PA0B
; 0021 !Redo the PCFORK stuff
; 0022 !<4.EXEC>EXECPX.B36.101, 27-Feb-82 02:40:03, Edit by PA0B
; 0023 !Make EXIT SAVE and EXIT TOPROGRAM set PCFORK to -1 to avoid
; 0024 !confusion.
; 0025 !<4.EXEC>EXECPX.B36.100, 8-Oct-81 13:41:40, Edit by DK32
; 0026 !Exec output stringblocks may be empty
; 0027 !<4.EXEC>EXECPX.B36.99, 20-May-81 16:09:03, Edit by DK32
; 0028 !Reset fork on Abort and error
; 0029 !<4.EXEC>EXECPX.B36.98, 10-Mar-81 16:51:58, Edit by DK32
; 0030 !New parse-in-progress logic so commands do confirmation,
; 0031 !Fix multiple-CR commands, Fix command argument reparse
; 0032 !<4.EXEC>EXECPX.B36.97, 25-Feb-81 21:52:40, Edit by DK32
; 0033 !Prompt, PassOutput
; 0034 !<4.EXEC>EXECPX.B36.96, 15-Jan-81 17:26:36, Edit by DK32
; 0035 !Pass both arguments to variable-routines
; 0036 !<4.EXEC>EXECPX.B36.95, 23-Dec-80 18:04:03, Edit by DK32
; 0037 !Use Exec linkage, Parse Invisible
; 0038 !<4.EXEC>EXECPX.B36.94, 15-Dec-80 17:51:50, Edit by DK32
; 0039 !Respect preserved context for procedures and commands
; 0040 !<4.EXEC>EXECPX.B36.93, 9-Dec-80 00:31:46, Edit by DK32
; 0041 !Save and ToProgram options to Exit
; 0042 !<4.EXEC>EXECPX.B36.92, 26-Nov-80 20:11:28, Edit by DK32
; 0043 !Allow for superceded global symbols
; 0044 !<4.EXEC>EXECPX.B36.91, 16-Nov-80 22:31:27, Edit by DK32
; 0045 !Read remainder of line after failed command argument,
; 0046 !Handle running out of memory for PDS typeout
; 0047 !<4.EXEC>EXECPX.B36.90, 30-Oct-80 14:07:24, Edit by DK32
; 0048 !Insert null after command in buffer
; 0049 !<4.EXEC>EXECPX.B36.89, 25-Oct-80 23:03:07, Edit by DK32
; 0050 !Cleanup invoked forks properly
; 0051 !<4.EXEC>EXECPX.B36.88, 18-Oct-80 15:53:07, Edit by DK32
; 0052 !Parse FileList, Get operands to subtract in proper order
; 0053 !<4.EXEC>EXECPX.B36.87, 9-Oct-80 18:37:16, Edit by DK32
; 0054 !Parsed JFN list, Fix substring overrun
; 0055 !<4.EXEC>EXECPX.B36.86, 2-Oct-80 20:16:23, Edit by DK32
; 0056 !Add Parse NoIndirect, Fix writeable system variables
; 0057 !<4.EXEC>EXECPX.B36.85, 24-Sep-80 17:08:59, Edit by DK32
; 0058 !Remove service routines to EXECPU
; 0059 !<4.EXEC>EXECPX.B36.84, 17-Sep-80 17:23:14, Edit by DK32
; 0060 !<4.EXEC>EXECPX.B36.83, 15-Sep-80 16:03:26, Edit by DK32
; 0061 !Use correct byte count in Typein
; 0062 !<4.EXEC>EXECPX.B36.82, 11-Sep-80 14:16:08, Edit by DK32
; 0063 !Strip linefeeds from Typein
; 0064 !<4.EXEC>EXECPX.B36.81, 7-Sep-80 20:50:03, Edit by DK32
; 0065 !Add $SearchRaised, Fix String[1:*], Fix message for substring
; 0066 !start less than 1, Add optional starting position argument
; 0067 !to $Search and $SearchRaised
; 0068 !<4.EXEC>EXECPX.B36.80, 20-Aug-80 16:55:26, Edit by DK32
; 0069 !Handle multiple line DoCommand with final null line,
; 0070 !Add $TermNumber
; 0071 !<DK32.CG>EXECPX.B36.79, 10-Aug-80 14:12:17, Edit by DK32
; 0072 !Keep PCT details in ECB, Handle multiple-line Docommand
; 0073 !better, Handle null DoCommand
; 0074 !<DK32.CG>EXECPX.B36.78, 1-Aug-80 15:09:42, Edit by DK32
; 0075 !Fix $TermWidth, Call PCITIN with real string
; 0076 !<DK32.CG>EXECPX.B36.77, 29-Jul-80 14:54:57, Edit by DK32
; 0077 !Don't kill user fork, just disengage it from PCL
; 0078 !<DK32.CG>EXECPX.B36.76, 17-Jul-80 13:30:59, Edit by DK32
; 0079 !Handle multi-line DoCommands
; 0080 !<DK32.CG>EXECPX.B36.75, 10-Jul-80 10:40:30, Edit by DK32
; 0081 !Add $ConnectedDirectory
; 0082 !<DK32.CG>EXECPX.B36.74, 3-Jul-80 14:10:02, Edit by DK32
; 0083 !SBS never returns error for length too long, Make MERGETAD a function,
; 0084 !Add INPUTTAD, Fix Abort to handle expressions, Have substring handle length -1
; 0085 MODULE EXECPX =
; 0086 BEGIN
; 0087
; 0088 !++
; 0089 !
; 0090 ! This is the first attempt at the Programmable Command Language executer
; 0091 !
; 0092 ! Dave King, Carnegie-Mellon University Computation Center
; 0093 !
; 0094 ! January, 1980
; 0095 !
; 0096 ! Copyright (C) 1980, Carnegie-Mellon University
; 0097 !
; 0098 !--
; 0099
; 0100 !++
; 0101 ! This module contains the bulk of the code necessary to actually
; 0102 ! run a stored command. Its only entry is the routine PCEXCT, which
; 0103 ! enters a fetch-execute cycle on the internal representation of the
; 0104 ! user's command. This module provides all the facilities of fetching
; 0105 ! instructions, decoding and fetching operands, performing the
; 0106 ! instruction, and storing the results. It calls routines in module
; 0107 ! EXECPI to provide services which could be called "system interfacing,"
; 0108 ! such as running user programs and writing to the terminal. Originally,
; 0109 ! I intended to divide things up so that there would be no need for
; 0110 ! this module to contain any JSYS instructions, but this rule has not
; 0111 ! been uniformly followed; it was not instituted in the interests of
; 0112 ! code purity, but to provide a rule of thumb to keep the modules
; 0113 ! of reasonable size.
; 0114 !--
; 0115
; 0116
; 0117 !
; 0118 ! Standard definitions
; 0119 !
; 0120
; 0121 LIBRARY 'EXECPD'; ! Get common definitions
; 0122 LIBRARY 'BLI:TENDEF'; ! Get system definitions
; 0123 LIBRARY 'BLI:MONSYM';
; WARN#050 ........1 L1:0123
; Name already declared in this block: $CHLFD
; WARN#050 ........1 L1:0123
; Name already declared in this block: $CHCRT
; WARN#050 ........1 L1:0123
; Name already declared in this block: $CHFFD
; 0124 SWITCHES LINKAGE(EXEC);
; 0125
; 0126 !
; 0127 ! Table of contents:
; 0128 !
; 0129
; 0130 FORWARD ROUTINE
; 0131 PCEERR, ! Report execution error
; 0132 PCEAST, ! Allocate string storage
; 0133 PCEFST: NOVALUE, ! Free string storage
; 0134 PCECST, ! Make copy of a string
; 0135 PCIRUN, ! Entry point for command invocation
; 0136 SETCTX: NOVALUE, ! Switch procedure context
; 0137 PCEGOP, ! Get value of operand
; 0138 PCESOP: NOVALUE, ! Store datum in operand
; 0139 CALPRC: NOVALUE, ! Call another procedure
; 0140 RETPRC: NOVALUE, ! Return from procedure
; 0141 DOCASE: NOVALUE, ! Indexed jump
; 0142 CLNVAR: NOVALUE, ! Clean up local string variables
; 0143 DOSBSS: NOVALUE, ! Extract substring
; 0144 DOCMND, ! DoCommand instruction
; 0145 PUTDCL, ! Send additional DoCommand lines
; 0146 DOCARG: NOVALUE, ! Get command arguments
; 0147 DPARSE: NOVALUE, ! Parse instruction
; 0148 COPFDB, ! Make real FLDDB from prototype
; 0149 COPKWT, ! Copy keyword table
; 0150 COPFDF: NOVALUE, ! Copy FILE defaults
; 0151 RELFDB: NOVALUE, ! Free storage for real FLDDB
; 0152 DPRMPT: NOVALUE, ! Prompt instruction
; 0153 GETEOP: NOVALUE, ! Get Exec output
; 0154 DOTINP: NOVALUE, ! Typein instruction
; 0155 DOGTYO: NOVALUE, ! Gettypout instruction
; 0156 DODPLY: NOVALUE, ! Display instruction
; 0157 CLIPRC: NOVALUE, ! Call internal routine
; 0158 PCEXCT; ! Main executer loop
; 0159
; 0160 !
; 0161 ! Macros:
; 0162 !
; 0163
; 0164 MACRO ERROR(TXT) = PCEERR(UPLIT(%ASCIZ TXT)) %;
; 0165
; 0166 !
; 0167 ! External references:
; 0168 !
; 0169
; 0170 EXTERNAL ROUTINE
; 0171 PCMGMM, ! General memory allocator
; 0172 RETMEM, ! EXECSU General memory release
; 0173 GETBUF, ! EXECSU Temporary memory allocate
; 0174 ERESET: NOVALUE, ! EXECP routine to reset program environment
; 0175 CLRINV: NOVALUE, ! EXECP routine to clear INVOKE'd fork flag
; 0176 PCIFGS, ! Find global symbol
; 0177 PCIPRS, ! Do COMND% for Parse
; 0178 PCIIVK: NOVALUE, ! Get and start up user program
; 0179 PCICLP: NOVALUE, ! Clean up all PTY/PDS's and forks
; 0180 PCIKIF: NOVALUE, ! Kill invoked fork
; 0181 PCITIN: NOVALUE, ! Type in to user program
; 0182 PCIPEO: NOVALUE, ! Prepare for Exec output
; 0183 PCIPSO: NOVALUE, ! Fake PTY-output pseudointerrupt
; 0184 PCIDPY: NOVALUE, ! Display string on real terminal
; 0185 PCIRPL: NOVALUE, ! Release Parsed JFN list
; 0186 DIVFNM, ! Get filename of current parsed JFN
; 0187 PCMITS, ! CVTBDO routine
; 0188 PCMXER, ! Report execution error
; 0189 PCMPER; ! Report parsing error
; 0190
; 0191 EXTERNAL
; 0192 PCCURC: REF ECB_BLK, ! Current Execution Context Block
; 0193 PCSFRE, ! Pointer to first free string block
; 0194 PCGBST: GST_TBL, ! Global symbol table
; 0195 PCTEXT: VECTOR, ! Text region
; 0196 PCSTAK: STKFRM, ! Run time stack
; 0197 PCLSTF, ! First unused word of run stack
; 0198 XDICT, ! Permanent storage pool
; 0199 DICT, ! Temporary storage pool
; 0200 CSBUFP: STR_VAL, ! Temporary string buffer pointer
; 0201 CJFNBK: VECTOR, ! Long-GTJFN block
; 0202 PCPOTP: VOLATILE, ! Address of block of user program output
; 0203 PCPEOP: VOLATILE, ! Address of block of Exec output
; 0204 PCLDCO, ! Flag to do command in original mode
; 0205 PSDEFN: SYN_TBL, ! System name table
; 0206 PCVVAL, ! Number parsed by last Parse
; 0207 PCVATM, ! Atom parsed by last Parse
; 0208 FORK: VOLATILE, ! Exec's current fork handle
; 0209 PCFORK: VOLATILE, ! Saved value of FORK
; 0210 PCRNFK: VOLATILE; ! Saved value of RUNFK
; 0211
; 0212 EXTERNAL LITERAL
; 0213 PCGBLN: UNSIGNED(3), ! Pages in global symbol table
; 0214 PCSTKL: UNSIGNED(3), ! Pages in run time stack
; 0215 PSDEFL: UNSIGNED(6); ! Length of system name table
; 0216 !
; 0217 ! Equated symbols:
; 0218 !
; 0219
; 0220 BIND
; 0221 CFM_FLDDB = UPLIT(%O'010000000000',0,0,0),
; 0222 GBSTLN=PCGBLN*512/GST_LEN, ! Maximum GST index possible
; 0223 STAKLN=PCSTKL*512, ! Execution stack length
; 0224 PC = PCSTAK, ! Program counter, relative to routine text
; 0225 FP = PCSTAK+1, ! Stack frame pointer, relative to PCSTAK
; 0226 STKP = FP+1, ! Stack pointer, relative to PCSTAK
; 0227 INSTR = STKP+1: BLOCK[2] FIELD(COD_FLD), ! Instruction being performed
; 0228 LSTPMT = INSTR+2, ! Location of last Prompt instruction
; 0229 CURGST = LSTPMT+1: REF GST_BLK, ! GST of current routine
; 0230 CURCOD = CURGST+1: REF COD_BLK, ! Pointer to code for current routine
; 0231 CURCDL = CURCOD+1, ! Its length
; 0232 CURCNS = CURCDL+1: REF VECTOR, ! Pointer to constants for routine
; 0233 CURCNL = CURCNS+1, ! Its length
; 0234 CURSMT = CURCNL+1: REF SYMENT, ! Symbol table for routine
; 0235 CURSML = CURSMT+1, ! Its length
; 0236 CMPTR = CURSML+1; ! Pointer to Exec's command buffer
; 0237
; 0238 GLOBAL LITERAL
; 0239 PCEOWN = 13; ! Length of executor context
; 0240
; 0241 GLOBAL ROUTINE PCEERR(MSG,PAR1) = ! Report execution error
; 0242
; 0243 !++
; 0244 ! Functional description:
; 0245 ! Clean up, issue error message and stop. The error message is
; 0246 ! provided as an ASCIZ string; anywhere a #n appears the n'th
; 0247 ! message parameter is inserted.
; 0248 !
; 0249 ! Formal parameters:
; 0250 ! Address of error message string
; 0251 ! Address of parameter string #1
; 0252 !
; 0253 ! Implicit inputs:
; 0254 ! Instruction being executed, global symbol for current procedure
; 0255 !
; 0256 ! Implicit outputs:
; 0257 ! None
; 0258 !
; 0259 ! Routine value:
; 0260 ! Really, none; does not return. I wish I could convince BLISS of that.
; 0261 !
; 0262 ! Side effects:
; 0263 ! Kills current controlled program, frees string variables
; 0264 !
; 0265 !--
; 0266
; 0267 %( Presently only works with one insert )%
; 0268
; 0269 BEGIN
; 0270 EXTERNAL REGISTER Z;
; 0271 LOCAL
; 0272 IPT, ! String pointers
; 0273 OPT,
; 0274 CHR, ! Character
; 0275 INSRT, ! Insertion pointer
; 0276 BUFF: VECTOR[25]; ! Message buffer
; 0277 PCICLP(1);
; 0278 CLNVAR();
; 0279 OPT = BYTPTR(BUFF);
; 0280 IPT = BYTPTR(.CURGST[GST_NMA]);
; 0281 WHILE (CHR = CH$RCHAR_A(IPT)) NEQ 0 DO CH$WCHAR_A(.CHR,OPT);
; 0282 IPT = CH$PTR( UPLIT (%ASCIZ ' Line '));
; 0283 WHILE (CHR = CH$RCHAR_A(IPT)) NEQ 0 DO CH$WCHAR_A(.CHR,OPT);
; 0284 OPT = PCMITS(.INSTR[COD_LNO],.OPT);
; 0285 CH$WCHAR_A(%C':', OPT);
; 0286 CH$WCHAR_A(%C' ', OPT);
; 0287 IPT = BYTPTR(.MSG);
; 0288 DO
; 0289 IF (CHR = CH$RCHAR_A(IPT)) EQL %C'#'
; 0290 THEN
; 0291 BEGIN
; 0292 CH$RCHAR_A(IPT); ! Skip the 1 which must follow
; 0293 INSRT = BYTPTR(.PAR1);
; 0294 WHILE (CHR = CH$RCHAR_A(INSRT)) NEQ 0 DO CH$WCHAR_A(.CHR,OPT);
; 0295 CHR = -1
; 0296 END
; 0297 ELSE
; 0298 CH$WCHAR_A(.CHR,OPT)
; 0299 UNTIL .CHR EQL 0;
; 0300 PCMXER(BUFF)
; 0301 END;
TITLE EXECPX
TWOSEG
.REQUEST SYS:B362LB.REL
RELOC 400000
P.AAA: EXP 10000000000
EXP 0
EXP 0
EXP 0
P.AAB: BYTE (7)" ","L","i","n","e" ; Line
BYTE (7)" ",000,000,000,000
EXTERN PCMGMM, RETMEM, GETBUF, ERESET, CLRINV, PCIFGS, PCIPRS, PCIIVK, PCICLP, PCIKIF, PCITIN
EXTERN PCIPEO, PCIPSO, PCIDPY, PCIRPL, DIVFNM, PCMITS, PCMXER, PCMPER, PCCURC, PCSFRE, PCGBST
EXTERN PCTEXT, PCSTAK, PCLSTF, XDICT, DICT, CSBUFP, CJFNBK, PCPOTP, PCPEOP, PCLDCO, PSDEFN
EXTERN PCVVAL, PCVATM, FORK, PCFORK, PCRNFK, PCGBLN, PCSTKL, PSDEFL
CFM_FLDDB= P.AAA
GBSTLN= <<PCGBLN*1000>/3>
STAKLN= <PCSTKL*1000>
PC= PCSTAK
; INFO#192
; Multiple declaration of name in assembly source: FP
FP= PCSTAK+1
STKP= PCSTAK+2
INSTR= PCSTAK+3
LSTPMT= PCSTAK+5
CURGST= PCSTAK+6
CURCOD= PCSTAK+7
CURCDL= PCSTAK+10
CURCNS= PCSTAK+11
CURCNL= PCSTAK+12
CURSMT= PCSTAK+13
CURSML= PCSTAK+14
CMPTR= PCSTAK+15
PCEOWN==: 15
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
PCEERR::PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,31 ; SP,31
MOVE AC11,AC2 ; PAR1,AC2
MOVE AC12,AC1 ; MSG,AC1
MOVEI AC1,1 ; AC1,1
PUSHJ SP,PCICLP ; SP,PCICLP
PUSHJ SP,CLNVAR ; SP,CLNVAR
MOVEI AC1,-30(SP) ; HLF,BUFF
HRLI AC1,-337100 ; HLF,-337100
MOVE AC2,AC1 ; OPT,HLF
MOVE AC1,CURGST ; AC1,CURGST
HRRZ AC1,2(AC1) ; HLF,2(AC1)
HRLI AC1,-337100 ; HLF,-337100
MOVE AC13,AC1 ; IPT,HLF
L.1: ILDB AC14,AC13 ; CHR,IPT
JUMPE AC14,L.2 ; CHR,L.2
IDPB AC14,AC2 ; CHR,OPT
JRST L.1 ; L.1
L.2: MOVE AC13,C.2 ; IPT,[POINT 7,P.AAB-1,34] <1,7>
L.3: ILDB AC14,AC13 ; CHR,IPT
JUMPE AC14,L.4 ; CHR,L.4
IDPB AC14,AC2 ; CHR,OPT
JRST L.3 ; L.3
L.4: LDB AC1,C.1 ; AC1,[POINT 9,INSTR,11] <24,9>
PUSHJ SP,PCMITS ; SP,PCMITS
MOVE AC2,AC1 ; OPT,AC1
MOVEI AC1,72 ; AC1,72
IDPB AC1,AC2 ; AC1,OPT
MOVEI AC1,40 ; AC1,40
IDPB AC1,AC2 ; AC1,OPT
MOVE AC1,AC12 ; HLF,MSG
HRLI AC1,-337100 ; HLF,-337100
MOVE AC13,AC1 ; IPT,HLF
L.5: ILDB AC14,AC13 ; CHR,IPT
CAIE AC14,43 ; CHR,43
JRST L.8 ; L.8
IBP AC13 ; IPT
MOVE AC1,AC11 ; HLF,PAR1
HRLI AC1,-337100 ; HLF,-337100
MOVE AC3,AC1 ; INSRT,HLF
L.6: ILDB AC14,AC3 ; CHR,INSRT
JUMPE AC14,L.7 ; CHR,L.7
IDPB AC14,AC2 ; CHR,OPT
JRST L.6 ; L.6
L.7: SETO AC14, ; CHR,
JRST L.9 ; L.9
L.8: IDPB AC14,AC2 ; CHR,OPT
L.9: JUMPN AC14,L.5 ; CHR,L.5
MOVEI AC1,-30(SP) ; AC1,BUFF
PUSHJ SP,PCMXER ; SP,PCMXER
ADJSP SP,-31 ; SP,-31
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 9,INSTR,11 ; 9,INSTR,11
C.2: POINT 7,P.AAB-1,34 ; 7,P.AAB-1,34
; Routine Size: 61 words
; 0302
; 0303 GLOBAL ROUTINE PCEAST (LEN) = ! Allocate string storage
; 0304
; 0305 !++
; 0306 ! Functional description:
; 0307 ! Allocate from string storage a block large enough to store
; 0308 ! LEN+1 characters.
; 0309 ! Strings are ALWAYS stored in ASCIZ format, but the final
; 0310 ! null is never seen by the user. This makes things much easier
; 0311 ! when we have to deal with the rest of the system. All real
; 0312 ! stringvalues consist of a length and an 18-bit address; the
; 0313 ! final null is NOT included in the length.
; 0314 ! This system does not collect garbage, but requires all users
; 0315 ! of the string pool to return strings when they are done with
; 0316 ! them. This means that every user string variable and every
; 0317 ! string system variable, if they contain pointers to strings
; 0318 ! at all, contain the ONLY pointers to those strings; LET A=B
; 0319 ! gives A a copy of the string in B, not a duplicate pointer.
; 0320 ! That allows a later LET A=C to release the string in A without
; 0321 ! requiring reference counters and other complexities.
; 0322 ! To keep the string pool under control, whenever ANY string
; 0323 ! variable is destroyed (that is, whenever a routine with
; 0324 ! string variables is exited) it should be freed. As a last
; 0325 ! resort, whenever the Exec exits from its outermost command
; 0326 ! context, we (will) free the entire string pool and start afresh.
; 0327 !
; 0328 ! Formal parameters:
; 0329 ! Number of bytes the block should be able to store, excluding the null
; 0330 !
; 0331 ! Implicit inputs:
; 0332 ! None
; 0333 !
; 0334 ! Implicit outputs:
; 0335 ! Free space list
; 0336 !
; 0337 ! Routine value:
; 0338 ! Real string value of block allocated. If desired length is not
; 0339 ! positive, value is zero.
; 0340 !
; 0341 ! Side effects:
; 0342 ! None
; 0343 !
; 0344 !--
; 0345
; 0346 BEGIN
; 0347 EXTERNAL REGISTER Z;
; 0348 LOCAL
; 0349 PTR,
; 0350 STR: STR_VAL;
; 0351 IF .LEN LEQ 0 THEN RETURN 0;
; 0352 PTR = PCMGMM((.LEN+5)/5, PCSFRE);
; 0353 IF .PTR LEQ 0 THEN ERROR('Out of execution string space');
; 0354 STR[STV_ADR] = .PTR;
; 0355 STR[STV_LEN] = .LEN;
; 0356 .STR
; 0357 END;
P.AAC: BYTE (7)"O","u","t"," ","o" ; Out o
BYTE (7)"f"," ","e","x","e" ; f exe
BYTE (7)"c","u","t","i","o" ; cutio
BYTE (7)"n"," ","s","t","r" ; n str
BYTE (7)"i","n","g"," ","s" ; ing s
BYTE (7)"p","a","c","e",000 ; pace
PCEAST::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC1 ; LEN,AC1
JUMPG AC14,L.10 ; LEN,L.10
SETZ AC1, ; AC1,
JRST L.12 ; L.12
L.10: MOVE AC1,AC14 ; AC1,LEN
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,PCSFRE ; AC2,PCSFRE
PUSHJ SP,PCMGMM ; SP,PCMGMM
MOVE AC13,AC1 ; PTR,AC1
JUMPG AC13,L.11 ; PTR,L.11
MOVEI AC1,P.AAC ; AC1,P.AAC
PUSHJ SP,PCEERR ; SP,PCEERR
L.11: HRR AC1,AC13 ; STR,PTR
HRL AC1,AC14 ; STR,LEN
L.12: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 20 words
; 0358
; 0359 GLOBAL ROUTINE PCEFST (STR): NOVALUE= ! Free string storage
; 0360
; 0361 !++
; 0362 ! Functional description:
; 0363 ! Release block obtained from free space by PCEAST.
; 0364 !
; 0365 ! Formal parameters:
; 0366 ! String value of block to be freed
; 0367 !
; 0368 ! Implicit inputs:
; 0369 ! None
; 0370 !
; 0371 ! Implicit outputs:
; 0372 ! Free space list
; 0373 !
; 0374 ! Routine value:
; 0375 ! None
; 0376 !
; 0377 ! Side effects:
; 0378 ! None
; 0379 !
; 0380 !--
; 0381
; 0382 BEGIN
; 0383 EXTERNAL REGISTER Z;
; 0384 MAP
; 0385 STR: STR_VAL;
; 0386 IF .STR[STV_LEN] NEQ 0
; 0387 THEN
; 0388 RETMEM((.STR[STV_LEN]+5)/5, .STR[STV_ADR], PCSFRE)
; 0389 END;
PCEFST::MOVE AC4,AC1 ; STR,AC1
HLRZ AC1,AC4 ; AC1,STR
JUMPE AC1,L.13 ; AC1,L.13
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,0(AC4) ; AC2,0(STR)
MOVEI AC3,PCSFRE ; AC3,PCSFRE
PUSHJ SP,RETMEM ; SP,RETMEM
L.13: POPJ SP, ; SP,
; Routine Size: 9 words
; 0390
; 0391 GLOBAL ROUTINE PCECST (STR) = ! Make copy of a string
; 0392
; 0393 !++
; 0394 ! Functional description:
; 0395 ! Given a real stringvalue, get a free block of appropriate size,
; 0396 ! copy the string, and return the real stringvalue of the copy.
; 0397 !
; 0398 ! Formal parameters:
; 0399 ! String value of original
; 0400 !
; 0401 ! Implicit inputs:
; 0402 ! None
; 0403 !
; 0404 ! Implicit outputs:
; 0405 ! None
; 0406 !
; 0407 ! Routine value:
; 0408 ! Real string value of string copy. If original string has no length,
; 0409 ! value is zero.
; 0410 !
; 0411 ! Side effects:
; 0412 ! None
; 0413 !
; 0414 !--
; 0415
; 0416 BEGIN
; 0417 EXTERNAL REGISTER Z;
; 0418 MAP
; 0419 STR: STR_VAL; ! Original string
; 0420 LOCAL
; 0421 NEW: STR_VAL; ! Copy being created
; 0422 IF .STR[STV_LEN] EQL 0 THEN RETURN 0;
; 0423 NEW = PCEAST(.STR[STV_LEN]);
; 0424 CH$COPY(.STR[STV_LEN], BYTPTR(.STR[STV_ADR]),
; 0425 0, .STR[STV_LEN]+1, BYTPTR(.NEW[STV_ADR]));
; 0426 .NEW
; 0427 END;
PCECST::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC1 ; STR,AC1
HLRZ AC13,AC14 ; AC13,STR
JUMPN AC13,L.14 ; AC13,L.14
SETZ AC1, ; AC1,
JRST L.15 ; L.15
L.14: MOVE AC1,AC13 ; AC1,AC13
PUSHJ SP,PCEAST ; SP,PCEAST
MOVE AC16,AC1 ; NEW,AC1
MOVEI AC2,0(AC14) ; HLF,0(STR)
HRLI AC2,-337100 ; HLF,-337100
MOVE AC3,AC13 ; AC3,AC13
ADDI AC3,1 ; AC3,1
MOVEI AC5,0(AC16) ; HLF,0(NEW)
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,AC13 ; AC1,AC13
MOVE AC4,AC3 ; AC4,AC3
EXTEND AC1,C.3 ; AC1,C.3
JFCL ;
MOVE AC1,AC16 ; AC1,NEW
L.15: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.3: MOVSLJ ;
EXP 0 ; 0
; Routine Size: 26 words
; 0428
; 0429 GLOBAL ROUTINE PCIRUN (RUNECB,RUNNAM) = ! Start command procedure
; 0430
; 0431 !++
; 0432 ! Functional description:
; 0433 ! Control reaches here to execute a command.
; 0434 ! I initialize the system to execute a command, filling in an
; 0435 ! Execution Context Block and in general establishing all the
; 0436 ! context which the Executer will require to begin executing
; 0437 ! instructions. I don't actually start the Executer now, but merely
; 0438 ! prepare it to "continue" execution of this command. The caller
; 0439 ! will return to the Exec after causing it to forget that it was
; 0440 ! just starting to parse a command, and after defining NUL: as the
; 0441 ! command input device. The Exec will then ask us for a whole new
; 0442 ! command, and at that point the command will be executed to
; 0443 ! generate a command.
; 0444 !
; 0445 ! Formal parameters:
; 0446 ! Address of Execution Context Block
; 0447 ! Stringvalue of name of command
; 0448 !
; 0449 ! Implicit inputs:
; 0450 ! Global symbol table
; 0451 !
; 0452 ! Implicit outputs:
; 0453 ! Execution Context Block
; 0454 !
; 0455 ! Routine value:
; 0456 ! True if command executed, False if could not be found
; 0457 !
; 0458 ! Side effects:
; 0459 ! None
; 0460 !
; 0461 !--
; 0462
; 0463 BEGIN
; 0464 EXTERNAL REGISTER Z;
; 0465 LOCAL
; 0466 EP: REF ECB_BLK, ! ECB pointer
; 0467 GS: REF GST_BLK; ! Global symbol table entry
; 0468 IF .PCCURC EQL 0 ! If top-level PCL command
; 0469 THEN
; 0470 STKP = PCEOWN; ! Initialize stack pointer
; 0471 IF .STKP + FRM_LOC + .GS[GST_SLN] GTR STAKLN
; 0472 THEN
; 0473 ERROR('Stack full');
; 0474 EP = .RUNECB;
; 0475 GS = .EP[ECB_GSC];
; 0476 EP[ECB_PC] = 0;
; 0477 EP[ECB_PRC] = .GS;
; 0478 EP[ECB_FP] = 0;
; 0479 EP[ECB_SP] = .STKP + FRM_LOC + .GS[GST_SLN];
; 0480 EP[ECB_STK] = .STKP + 1;
; 0481 EP[ECB_CTN] = 0;
; 0482 EP[ECB_CTJ] = 0;
; 0483 EP[ECB_DTN] = 0;
; 0484 EP[ECB_DTJ] = 0;
; 0485 EP[ECB_DCB] = 0;
; 0486 EP[ECB_DTO] = %O'777777';
; 0487 EP[ECB_RCL] = 0;
; 0488 EP[ECB_PFL] = 0;
; 0489 EP[ECB_CFK] = 0;
; 0490 EP[ECB_PAR] = 1;
; 0491 EP[ECB_SCM] = 0;
; 0492 EP[ECB_ECO] = 0;
; 0493 TRUE
; 0494 END;
P.AAD: BYTE (7)"S","t","a","c","k" ; Stack
BYTE (7)" ","f","u","l","l" ; full
BYTE (7)000,000,000,000,000
PCIRUN::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC13,AC1 ; RUNECB,AC1
SKIPE PCCURC ; PCCURC
JRST L.16 ; L.16
MOVEI AC1,15 ; AC1,15
MOVEM AC1,STKP ; AC1,STKP
L.16: MOVE AC1,STKP ; AC1,STKP
LDB AC2,C.4 ; AC2,[POINT 8,0(GS),17] <18,8>
ADD AC1,AC2 ; AC1,AC2
ADDI AC1,2 ; AC1,2
CAMG AC1,C.5 ; AC1,[<PCSTKL*1000>]
JRST L.17 ; L.17
MOVEI AC1,P.AAD ; AC1,P.AAD
PUSHJ SP,PCEERR ; SP,PCEERR
L.17: MOVE AC1,AC13 ; EP,RUNECB
HRRZ AC14,7(AC1) ; GS,7(EP)
HLLZS 2(AC1) ; 2(EP)
HRLM AC14,0(AC1) ; GS,0(EP)
HRRZS 2(AC1) ; 2(EP)
MOVE AC2,STKP ; AC2,STKP
LDB AC3,C.4 ; AC3,[POINT 8,0(GS),17] <18,8>
ADD AC2,AC3 ; AC2,AC3
ADDI AC2,2 ; AC2,2
HRRM AC2,3(AC1) ; AC2,3(EP)
MOVE AC2,STKP ; AC2,STKP
ADDI AC2,1 ; AC2,1
HRLM AC2,3(AC1) ; AC2,3(EP)
HLLZS 4(AC1) ; 4(EP)
HRRZS 4(AC1) ; 4(EP)
HLLZS 5(AC1) ; 5(EP)
HRRZS 5(AC1) ; 5(EP)
HLLZS 6(AC1) ; 6(EP)
HRROS 6(AC1) ; 6(EP)
HRRZS 7(AC1) ; 7(EP)
HLLZS 10(AC1) ; 10(EP)
HRRZS 10(AC1) ; 10(EP)
MOVSI AC2,10000 ; AC2,10000
IORM AC2,12(AC1) ; AC2,12(EP)
MOVSI AC2,100000 ; AC2,100000
ANDCAM AC2,12(AC1) ; AC2,12(EP)
MOVSI AC2,40000 ; AC2,40000
ANDCAM AC2,12(AC1) ; AC2,12(EP)
SETO AC1, ; AC1,
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.4: POINT 8,0(AC14),17 ; 8,0(GS),17
C.5: EXP <PCSTKL*1000> ; <PCSTKL*1000>
; Routine Size: 49 words
; 0495
; 0496 ROUTINE SETCTX: NOVALUE = ! Switch procedure context
; 0497
; 0498 !++
; 0499 ! Functional description:
; 0500 ! Given the address of a routine's global symbol table entry in
; 0501 ! CURGST, load the other pointers required for normal operation
; 0502 ! within that routine, defining the locations of the routine's
; 0503 ! instructions, constants, and symbols.
; 0504 !
; 0505 ! Formal parameters:
; 0506 ! None
; 0507 !
; 0508 ! Implicit inputs:
; 0509 ! CURGST, Global symbol table
; 0510 !
; 0511 ! Implicit outputs:
; 0512 ! CURCOD, CURCDL, CURCNS, CURCNL, CURSMT, CURSML
; 0513 !
; 0514 ! Routine value:
; 0515 ! None
; 0516 !
; 0517 ! Side effects:
; 0518 ! None
; 0519 !
; 0520 !--
; 0521
; 0522 BEGIN
; 0523 LOCAL
; 0524 GST: REF GST_BLK; ! Pointer to global symbol table entry
; 0525 GST = .CURGST;
; 0526 CURCOD = .GST[GST_TXT];
; 0527 CURCDL = .GST[GST_COD];
; 0528 IF .GST[GST_CLS] EQL GST_CLS_CMD
; 0529 THEN
; 0530 CURCNS = .CURCOD + .CURCDL
; 0531 ELSE
; 0532 CURCNS = .CURCOD + .CURCDL + .GST[GST_PCT];
; 0533 CURCNL = .GST[GST_CNS];
; 0534 CURSMT = .CURCNS + .CURCNL;
; 0535 CURSML = .GST[GST_SML]
; 0536 END;
SETCTX: MOVE AC1,CURGST ; GST,CURGST
HRRZ AC2,0(AC1) ; AC2,0(GST)
MOVEM AC2,CURCOD ; AC2,CURCOD
LDB AC2,C.6 ; AC2,[POINT 12,1(GST),35] <0,12>
MOVEM AC2,CURCDL ; AC2,CURCDL
MOVE AC2,CURCOD ; AC2,CURCOD
ADD AC2,CURCDL ; AC2,CURCDL
LDB AC3,C.7 ; AC3,[POINT 3,0(GST),4] <31,3>
JUMPE AC3,L.18 ; AC3,L.18
LDB AC3,C.8 ; AC3,[POINT 4,0(GST),9] <26,4>
ADD AC2,AC3 ; AC2,AC3
L.18: MOVEM AC2,CURCNS ; AC2,CURCNS
LDB AC2,C.9 ; AC2,[POINT 12,1(GST),23] <12,12>
MOVEM AC2,CURCNL ; AC2,CURCNL
MOVE AC2,CURCNS ; AC2,CURCNS
ADD AC2,CURCNL ; AC2,CURCNL
MOVEM AC2,CURSMT ; AC2,CURSMT
LDB AC2,C.10 ; AC2,[POINT 12,1(GST),11] <24,12>
MOVEM AC2,CURSML ; AC2,CURSML
POPJ SP, ; SP,
C.6: POINT 12,1(AC1),35 ; 12,1(GST),35
C.7: POINT 3,0(AC1),4 ; 3,0(GST),4
C.8: POINT 4,0(AC1),9 ; 4,0(GST),9
C.9: POINT 12,1(AC1),23 ; 12,1(GST),23
C.10: POINT 12,1(AC1),11 ; 12,1(GST),11
; Routine Size: 25 words
; 0537
; 0538 GLOBAL ROUTINE PCEGOP (OPND,TYP) = ! Get value of operand
; 0539
; 0540 !++
; 0541 ! Functional description
; 0542 ! Given an operand descriptor taken from an instruction, identifies
; 0543 ! the object being referenced, locates the datum, and returns it.
; 0544 ! Possible data are integers and string values; caller provides
; 0545 ! expected type.
; 0546 !
; 0547 ! Formal parameters:
; 0548 ! Operand descriptor
; 0549 ! Type to be fetched (STE_TYP_INT or STE_TYP_STR)
; 0550 !
; 0551 ! Implicit inputs:
; 0552 ! Local symbol table, global symbol table, stack frame, constant area,
; 0553 ! string space
; 0554 !
; 0555 ! Implicit outputs:
; 0556 ! None
; 0557 !
; 0558 ! Routine value:
; 0559 ! Datum, either integer or stringvalue
; 0560 !
; 0561 ! Side effects:
; 0562 ! None
; 0563 !
; 0564 !--
; 0565
; 0566 BEGIN
; 0567 EXTERNAL REGISTER Z;
; 0568 MAP
; 0569 OPND: OPRAND;
; 0570 LOCAL
; 0571 OPA, ! Address of datum
; 0572 OPV; ! Value being located
; 0573 OPA = .OPND[OPN_ADR];
; 0574 CASE .OPND[OPN_CLS] FROM OPN_CLS_VAR TO OPN_CLS_TMP OF
; 0575 SET
; 0576 [OPN_CLS_VAR]: BEGIN
; 0577 ! User variable; OPA has local symbol table index
; 0578 LOCAL
; 0579 STE: REF STE_BLK;
; 0580 STE = CURSMT[.OPA,STE_WRD];
; 0581 IF .STE[STE_TYP] NEQ .TYP THEN ERROR('Incorrect operand type');
; 0582 CASE .STE[STE_CLS] FROM STE_CLS_VAR TO STE_CLS_FCN OF
; 0583 SET
; 0584 [STE_CLS_VAR]: BEGIN
; 0585 OPV = .PCSTAK[.FP+.STE[STE_LOC],FRM_WRD];
; 0586 END;
; 0587 [STE_CLS_GBL]: BEGIN
; 0588 LOCAL
; 0589 GST: REF GST_BLK; ! Global symbol table entry
; 0590 GST = PCIFGS(.STE[STE_NAM]+.CURCNS,0);
; 0591 IF .GST GEQ 0
; 0592 THEN
; 0593 IF .GST[GST_CLS] NEQ GST_CLS_VAR THEN GST = -1;
; 0594 IF .GST LSS 0
; 0595 THEN
; 0596 ERROR('Undefined global variable referenced');
; 0597 IF .GST[GST_TYP] NEQ .TYP
; 0598 THEN
; 0599 ERROR('Incorrect operand type');
; 0600 OPV = .GST[GST_VAL]
; 0601 END;
; 0602 [STE_CLS_FML]: BEGIN
; 0603 LOCAL
; 0604 OPN: OPRAND, ! Operand descriptor
; 0605 SAVEFP, ! Save for current FP
; 0606 SAVEGS; ! ... CURGST
; 0607 OPN[OPN_WRD] = .PCSTAK[.FP+.STE[STE_LOC],FRM_WRD];
; 0608 IF .OPN[OPN_CLS] EQL OPN_CLS_TMP
; 0609 THEN
; 0610 BEGIN
; 0611 OPA = .OPN[OPN_ADR];
; 0612 OPV = .PCSTAK[.OPA,FRM_WRD]
; 0613 END
; 0614 ELSE
; 0615 BEGIN
; 0616 SAVEFP = .FP;
; 0617 SAVEGS = .CURGST;
; 0618 CURGST = .PCSTAK[.FP,FRM_PRC];
; 0619 FP = .PCSTAK[.FP,FRM_PRV];
; 0620 SETCTX();
; 0621 OPV = PCEGOP(.OPN[OPN_WRD],.TYP);
; 0622 FP = .SAVEFP;
; 0623 CURGST = .SAVEGS;
; 0624 SETCTX()
; 0625 END
; 0626 END;
; 0627 [STE_CLS_PRC,
; 0628 STE_CLS_FCN]: ERROR('Attempt to fetch from routine')
; 0629 TES
; 0630 END;
; 0631 [OPN_CLS_SYN]: BEGIN
; 0632 ! System variable
; 0633 IF .PSDEFN[.OPA,SYN_CLS] NEQ SYN_CLS_VAR
; 0634 THEN
; 0635 ERROR('Fetch from system procedure');
; 0636 IF .PSDEFN[.OPA,SYN_TYP] NEQ .TYP
; 0637 THEN
; 0638 ERROR('Incorrect operand type');
; 0639 IF .PSDEFN[.OPA,SYN_RTV]
; 0640 THEN
; 0641 OPV = (.PSDEFN[.OPA,SYN_ADR])(0,0)
; 0642 ELSE
; 0643 OPV = ..PSDEFN[.OPA,SYN_ADR]
; 0644 END;
; 0645 [OPN_CLS_CNS]: BEGIN
; 0646 ! Constant
; 0647 IF .TYP NEQ .OPND[OPN_STR]
; 0648 THEN
; 0649 ERROR('Incorrect operand type');
; 0650 OPV = .CURCNS[.OPA];
; 0651 IF .OPND[OPN_STR] THEN OPV = .OPV + .CURCNS
; 0652 END;
; 0653 [OPN_CLS_TMP]: BEGIN
; 0654 ! Temporary variable to be popped from stack
; 0655 OPV = .PCSTAK[.STKP,FRM_WRD];
; 0656 IF .STKP EQL PCEOWN
; 0657 THEN
; 0658 ERROR('PCL internal error - stack underflow');
; 0659 STKP = .STKP - 1
; 0660 END
; 0661 TES;
; 0662 .OPV
; 0663 END;
P.AAE: BYTE (7)"I","n","c","o","r" ; Incor
BYTE (7)"r","e","c","t"," " ; rect
BYTE (7)"o","p","e","r","a" ; opera
BYTE (7)"n","d"," ","t","y" ; nd ty
BYTE (7)"p","e",000,000,000 ; pe
P.AAF: BYTE (7)"U","n","d","e","f" ; Undef
BYTE (7)"i","n","e","d"," " ; ined
BYTE (7)"g","l","o","b","a" ; globa
BYTE (7)"l"," ","v","a","r" ; l var
BYTE (7)"i","a","b","l","e" ; iable
BYTE (7)" ","r","e","f","e" ; refe
BYTE (7)"r","e","n","c","e" ; rence
BYTE (7)"d",000,000,000,000 ; d
P.AAG: BYTE (7)"I","n","c","o","r" ; Incor
BYTE (7)"r","e","c","t"," " ; rect
BYTE (7)"o","p","e","r","a" ; opera
BYTE (7)"n","d"," ","t","y" ; nd ty
BYTE (7)"p","e",000,000,000 ; pe
P.AAH: BYTE (7)"A","t","t","e","m" ; Attem
BYTE (7)"p","t"," ","t","o" ; pt to
BYTE (7)" ","f","e","t","c" ; fetc
BYTE (7)"h"," ","f","r","o" ; h fro
BYTE (7)"m"," ","r","o","u" ; m rou
BYTE (7)"t","i","n","e",000 ; tine
P.AAI: BYTE (7)"F","e","t","c","h" ; Fetch
BYTE (7)" ","f","r","o","m" ; from
BYTE (7)" ","s","y","s","t" ; syst
BYTE (7)"e","m"," ","p","r" ; em pr
BYTE (7)"o","c","e","d","u" ; ocedu
BYTE (7)"r","e",000,000,000 ; re
P.AAJ: BYTE (7)"I","n","c","o","r" ; Incor
BYTE (7)"r","e","c","t"," " ; rect
BYTE (7)"o","p","e","r","a" ; opera
BYTE (7)"n","d"," ","t","y" ; nd ty
BYTE (7)"p","e",000,000,000 ; pe
P.AAK: BYTE (7)"I","n","c","o","r" ; Incor
BYTE (7)"r","e","c","t"," " ; rect
BYTE (7)"o","p","e","r","a" ; opera
BYTE (7)"n","d"," ","t","y" ; nd ty
BYTE (7)"p","e",000,000,000 ; pe
P.AAL: BYTE (7)"P","C","L"," ","i" ; PCL i
BYTE (7)"n","t","e","r","n" ; ntern
BYTE (7)"a","l"," ","e","r" ; al er
BYTE (7)"r","o","r"," ","-" ; ror -
BYTE (7)" ","s","t","a","c" ; stac
BYTE (7)"k"," ","u","n","d" ; k und
BYTE (7)"e","r","f","l","o" ; erflo
BYTE (7)"w",000,000,000,000 ; w
PCEGOP::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 ; TYP,AC2
MOVE AC12,AC1 ; OPND,AC1
LDB AC13,C.11 ; OPA,[POINT 15,OPND,35] <0,15>
LDB AC1,C.12 ; AC1,[POINT 2,OPND,19] <16,2>
JRST L.19(AC1) ; L.19(AC1)
L.19: JRST L.20 ; L.20
JRST L.31 ; L.31
JRST L.35 ; L.35
JRST L.37 ; L.37
L.20: MOVE AC14,AC13 ; AC14,OPA
IMULI AC14,2 ; AC14,2
ADD AC14,CURSMT ; AC14,CURSMT
LDB AC1,C.13 ; AC1,[POINT 1,0(STE),6] <29,1>
CAMN AC1,AC10 ; AC1,TYP
JRST L.21 ; L.21
MOVEI AC1,P.AAE ; AC1,P.AAE
PUSHJ SP,PCEERR ; SP,PCEERR
L.21: LDB AC1,C.14 ; AC1,[POINT 3,0(STE),5] <30,3>
JRST L.22(AC1) ; L.22(AC1)
L.22: JRST L.23 ; L.23
JRST L.24 ; L.24
JRST L.28 ; L.28
JRST L.30 ; L.30
JRST L.30 ; L.30
L.23: MOVE AC1,FP ; AC1,FP
HRRE AC2,0(AC14) ; AC2,0(STE)
ADD AC1,AC2 ; AC1,AC2
MOVE AC11,PCSTAK(AC1) ; OPV,PCSTAK(AC1)
JRST L.39 ; L.39
L.24: MOVE AC1,1(AC14) ; AC1,1(STE)
ADD AC1,CURCNS ; AC1,CURCNS
SETZ AC2, ; AC2,
PUSHJ SP,PCIFGS ; SP,PCIFGS
MOVE AC14,AC1 ; GST,AC1
JUMPL AC14,L.25 ; GST,L.25
LDB AC1,C.15 ; AC1,[POINT 3,0(GST),4] <31,3>
CAIE AC1,2 ; AC1,2
SETO AC14, ; GST,
L.25: JUMPGE AC14,L.26 ; GST,L.26
MOVEI AC1,P.AAF ; AC1,P.AAF
PUSHJ SP,PCEERR ; SP,PCEERR
L.26: LDB AC1,C.16 ; AC1,[POINT 1,0(GST),5] <30,1>
CAMN AC1,AC10 ; AC1,TYP
JRST L.27 ; L.27
MOVEI AC1,P.AAG ; AC1,P.AAG
PUSHJ SP,PCEERR ; SP,PCEERR
L.27: MOVE AC11,1(AC14) ; OPV,1(GST)
JRST L.39 ; L.39
L.28: MOVE AC2,FP ; AC2,FP
HRRE AC3,0(AC14) ; AC3,0(STE)
MOVE AC1,AC2 ; AC1,AC2
ADD AC1,AC3 ; AC1,AC3
MOVE AC12,PCSTAK(AC1) ; OPN,PCSTAK(AC1)
LDB AC1,C.12 ; AC1,[POINT 2,OPND,19] <16,2>
CAIE AC1,3 ; AC1,3
JRST L.29 ; L.29
LDB AC13,C.11 ; OPA,[POINT 15,OPND,35] <0,15>
MOVE AC11,PCSTAK(AC13) ; OPV,PCSTAK(OPA)
JRST L.39 ; L.39
L.29: MOVE AC14,AC2 ; SAVEFP,AC2
MOVE AC1,CURGST ; AC1,CURGST
MOVEM AC1,0(SP) ; AC1,SAVEGS
HRRZ AC1,PCSTAK+1(AC2) ; AC1,PCSTAK+1(AC2)
MOVEM AC1,CURGST ; AC1,CURGST
MOVE AC1,FP ; AC1,FP
HLRZ AC2,PCSTAK(AC1) ; AC2,PCSTAK(AC1)
MOVEM AC2,FP ; AC2,FP
PUSHJ SP,SETCTX ; SP,SETCTX
MOVE AC1,AC12 ; AC1,OPN
MOVE AC2,AC10 ; AC2,TYP
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC11,AC1 ; OPV,AC1
MOVEM AC14,FP ; SAVEFP,FP
MOVE AC1,0(SP) ; AC1,SAVEGS
MOVEM AC1,CURGST ; AC1,CURGST
PUSHJ SP,SETCTX ; SP,SETCTX
JRST L.39 ; L.39
L.30: MOVEI AC1,P.AAH ; AC1,P.AAH
PUSHJ SP,PCEERR ; SP,PCEERR
JRST L.39 ; L.39
L.31: MOVE AC14,AC13 ; AC14,OPA
IMULI AC14,2 ; AC14,2
LDB AC1,C.17 ; AC1,[POINT 3,PSDEFN(AC14),17] <18,3>
CAIN AC1,2 ; AC1,2
JRST L.32 ; L.32
MOVEI AC1,P.AAI ; AC1,P.AAI
PUSHJ SP,PCEERR ; SP,PCEERR
L.32: LDB AC1,C.18 ; AC1,[POINT 3,PSDEFN(AC14),14] <21,3>
CAMN AC1,AC10 ; AC1,TYP
JRST L.33 ; L.33
MOVEI AC1,P.AAJ ; AC1,P.AAJ
PUSHJ SP,PCEERR ; SP,PCEERR
L.33: HRRZ AC3,PSDEFN+1(AC14) ; AC3,PSDEFN+1(AC14)
SKIPL PSDEFN(AC14) ; PSDEFN(AC14)
JRST L.34 ; L.34
SETZB AC1,AC2 ; AC1,AC2
PUSHJ SP,0(AC3) ; SP,0(AC3)
MOVE AC11,AC1 ; OPV,AC1
JRST L.39 ; L.39
L.34: MOVE AC11,0(AC3) ; OPV,0(AC3)
JRST L.39 ; L.39
L.35: LDB AC1,C.19 ; AC1,[POINT 1,OPND,20] <15,1>
CAMN AC10,AC1 ; TYP,AC1
JRST L.36 ; L.36
MOVEI AC1,P.AAK ; AC1,P.AAK
PUSHJ SP,PCEERR ; SP,PCEERR
L.36: MOVE AC1,CURCNS ; AC1,CURCNS
MOVE AC2,AC1 ; AC2,AC1
ADD AC2,AC13 ; AC2,OPA
MOVE AC11,0(AC2) ; OPV,0(AC2)
TRNE AC12,100000 ; OPND,100000
ADD AC11,AC1 ; OPV,AC1
JRST L.39 ; L.39
L.37: MOVE AC1,STKP ; AC1,STKP
MOVE AC11,PCSTAK(AC1) ; OPV,PCSTAK(AC1)
CAIE AC1,15 ; AC1,15
JRST L.38 ; L.38
MOVEI AC1,P.AAL ; AC1,P.AAL
PUSHJ SP,PCEERR ; SP,PCEERR
L.38: SOS STKP ; STKP
L.39: MOVE AC1,AC11 ; AC1,OPV
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.11: POINT 15,AC12,35 ; 15,OPND,35
C.12: POINT 2,AC12,19 ; 2,OPND,19
C.13: POINT 1,0(AC14),6 ; 1,0(STE),6
C.14: POINT 3,0(AC14),5 ; 3,0(STE),5
C.15: POINT 3,0(AC14),4 ; 3,0(GST),4
C.16: POINT 1,0(AC14),5 ; 1,0(GST),5
C.17: POINT 3,PSDEFN(AC14),17 ; 3,PSDEFN(AC14),17
C.18: POINT 3,PSDEFN(AC14),14 ; 3,PSDEFN(AC14),14
C.19: POINT 1,AC12,20 ; 1,OPND,20
; Routine Size: 143 words
; 0664
; 0665 GLOBAL ROUTINE PCESOP (OPND,OPV,TYP): NOVALUE = ! Store datum in operand
; 0666
; 0667 !++
; 0668 ! Functional description:
; 0669 ! Given an operand descriptor taken from an instruction, identifies
; 0670 ! the object being referenced and stores the datum in the appropriate
; 0671 ! location. Requires that the destination is a fit repository for
; 0672 ! the type of datum.
; 0673 !
; 0674 ! Formal parameters:
; 0675 ! Operand descriptor
; 0676 ! Datum, either integer or string value
; 0677 ! Type of datum (STE_TYP_INT or STE_TYP_STR)
; 0678 !
; 0679 ! Implicit inputs:
; 0680 ! Symbol tables, stack frame
; 0681 !
; 0682 ! Implicit outputs:
; 0683 ! Symbol tables, stack frame
; 0684 !
; 0685 ! Routine value:
; 0686 ! None
; 0687 !
; 0688 ! Side effects:
; 0689 ! None
; 0690 !
; 0691 !--
; 0692
; 0693 BEGIN
; 0694 EXTERNAL REGISTER Z;
; 0695 MAP
; 0696 OPND: OPRAND;
; 0697 LOCAL
; 0698 OLD,
; 0699 OPA,
; 0700 OPS,
; 0701 STE: REF STE_BLK; ! Pointer to symbol table entry
; 0702 OPA = .OPND[OPN_ADR];
; 0703 CASE .OPND[OPN_CLS] FROM OPN_CLS_VAR TO OPN_CLS_TMP OF
; 0704 SET
; 0705 [OPN_CLS_VAR]: BEGIN
; 0706 ! User variable
; 0707 STE = CURSMT[.OPA,STE_WRD];
; 0708 IF .STE[STE_TYP] NEQ .TYP THEN ERROR('Incorrect operand type');
; 0709 CASE .STE[STE_CLS] FROM STE_CLS_VAR TO STE_CLS_FCN OF
; 0710 SET
; 0711 [STE_CLS_VAR]: BEGIN
; 0712 OLD = .PCSTAK[.FP+.STE[STE_LOC],FRM_WRD];
; 0713 PCSTAK[.FP+.STE[STE_LOC],FRM_WRD] = .OPV;
; 0714 IF .TYP EQL STE_TYP_STR THEN PCEFST(.OLD)
; 0715 END;
; 0716 [STE_CLS_GBL]: BEGIN
; 0717 LOCAL
; 0718 GST: REF GST_BLK, ! Global symbol table entry
; 0719 NEWV: STR_VAL,
; 0720 STRO: STR_VAL;
; 0721 GST= PCIFGS(.STE[STE_NAM]+.CURCNS,0);
; 0722 IF .GST GEQ 0
; 0723 THEN
; 0724 IF .GST[GST_CLS] NEQ GST_CLS_VAR THEN GST = -1;
; 0725 IF .GST LSS 0
; 0726 THEN
; 0727 ERROR('Undefined global variable referenced');
; 0728 IF .GST[GST_TYP] NEQ .TYP
; 0729 THEN
; 0730 ERROR('Incorrect operand type');
; 0731 IF .TYP EQL STE_TYP_INT
; 0732 THEN
; 0733 GST[GST_VAL] = .OPV
; 0734 ELSE
; 0735 BEGIN
; 0736 STRO = .GST[GST_VAL];
; 0737 IF .STRO NEQ 0
; 0738 THEN
; 0739 BEGIN
; 0740 RETMEM((.STRO[STV_LEN]+5)/5,.STRO[STV_ADR],XDICT);
; 0741 GST[GST_VAL] = 0
; 0742 END;
; 0743 NEWV = .OPV;
; 0744 IF .NEWV NEQ 0
; 0745 THEN
; 0746 BEGIN
; 0747 STRO = PCMGMM( (.NEWV[STV_LEN]+5)/5, XDICT);
; 0748 STRO[STV_LEN] = .NEWV[STV_LEN];
; 0749 CH$MOVE(.NEWV[STV_LEN]+1,BYTPTR(.NEWV[STV_ADR]),
; 0750 BYTPTR(.STRO[STV_ADR]));
; 0751 GST[GST_VAL] = .STRO;
; 0752 PCEFST(.NEWV)
; 0753 END
; 0754 END
; 0755 END;
; 0756 [STE_CLS_FML]: BEGIN
; 0757 LOCAL
; 0758 OPN: OPRAND, ! Operand descriptor
; 0759 SAVEFP, ! Save for current FP
; 0760 SAVEGS; ! ... CURGST
; 0761 OPN[OPN_WRD] = .PCSTAK[.FP+.STE[STE_LOC],FRM_WRD];
; 0762 IF .OPN[OPN_CLS] EQL OPN_CLS_TMP
; 0763 THEN
; 0764 ERROR('Cannot store into value-only parameter');
; 0765 SAVEFP = .FP;
; 0766 SAVEGS = .CURGST;
; 0767 CURGST = .PCSTAK[.FP,FRM_PRC];
; 0768 FP = .PCSTAK[.FP,FRM_PRV];
; 0769 SETCTX();
; 0770 PCESOP(.OPN[OPN_WRD],.OPV,.TYP);
; 0771 FP = .SAVEFP;
; 0772 CURGST = .SAVEGS;
; 0773 SETCTX()
; 0774 END;
; 0775 [STE_CLS_PRC,
; 0776 STE_CLS_FCN]: ERROR('Attempt to store into procedure')
; 0777 TES
; 0778 END;
; 0779 [OPN_CLS_SYN]: BEGIN
; 0780 ! System variable
; 0781 IF .PSDEFN[.OPA,SYN_CLS] NEQ SYN_CLS_VAR
; 0782 THEN
; 0783 ERROR('Cannot set system procedure');
; 0784 IF NOT .PSDEFN[.OPA,SYN_WRT]
; 0785 THEN
; 0786 ERROR('Cannot set readonly system variable');
; 0787 IF .PSDEFN[.OPA,SYN_TYP] NEQ .TYP
; 0788 THEN
; 0789 ERROR('Incorrect operand type');
; 0790 IF .PSDEFN[.OPA,SYN_RTV]
; 0791 THEN
; 0792 (.PSDEFN[.OPA,SYN_ADR])(.OPV,-1)
; 0793 ELSE
; 0794 .PSDEFN[.OPA,SYN_ADR] = .OPV
; 0795 END;
; 0796 [OPN_CLS_CNS]: ERROR('Cannot store into a constant');
; 0797 [OPN_CLS_TMP]: BEGIN
; 0798 ! Temporary to be pushed onto stack
; 0799 IF .STKP EQL STAKLN
; 0800 THEN
; 0801 ERROR('Stack full');
; 0802 STKP = .STKP + 1;
; 0803 PCSTAK[.STKP,FRM_WRD] = .OPV
; 0804 END
; 0805 TES
; 0806 END;
P.AAM: BYTE (7)"I","n","c","o","r" ; Incor
BYTE (7)"r","e","c","t"," " ; rect
BYTE (7)"o","p","e","r","a" ; opera
BYTE (7)"n","d"," ","t","y" ; nd ty
BYTE (7)"p","e",000,000,000 ; pe
P.AAN: BYTE (7)"U","n","d","e","f" ; Undef
BYTE (7)"i","n","e","d"," " ; ined
BYTE (7)"g","l","o","b","a" ; globa
BYTE (7)"l"," ","v","a","r" ; l var
BYTE (7)"i","a","b","l","e" ; iable
BYTE (7)" ","r","e","f","e" ; refe
BYTE (7)"r","e","n","c","e" ; rence
BYTE (7)"d",000,000,000,000 ; d
P.AAO: BYTE (7)"I","n","c","o","r" ; Incor
BYTE (7)"r","e","c","t"," " ; rect
BYTE (7)"o","p","e","r","a" ; opera
BYTE (7)"n","d"," ","t","y" ; nd ty
BYTE (7)"p","e",000,000,000 ; pe
P.AAP: 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"," ","v","a" ; to va
BYTE (7)"l","u","e","-","o" ; lue-o
BYTE (7)"n","l","y"," ","p" ; nly p
BYTE (7)"a","r","a","m","e" ; arame
BYTE (7)"t","e","r",000,000 ; ter
P.AAQ: BYTE (7)"A","t","t","e","m" ; Attem
BYTE (7)"p","t"," ","t","o" ; pt to
BYTE (7)" ","s","t","o","r" ; stor
BYTE (7)"e"," ","i","n","t" ; e int
BYTE (7)"o"," ","p","r","o" ; o pro
BYTE (7)"c","e","d","u","r" ; cedur
BYTE (7)"e",000,000,000,000 ; e
P.AAR: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","s","e","t" ; t set
BYTE (7)" ","s","y","s","t" ; syst
BYTE (7)"e","m"," ","p","r" ; em pr
BYTE (7)"o","c","e","d","u" ; ocedu
BYTE (7)"r","e",000,000,000 ; re
P.AAS: BYTE (7)"C","a","n","n","o" ; Canno
BYTE (7)"t"," ","s","e","t" ; t set
BYTE (7)" ","r","e","a","d" ; read
BYTE (7)"o","n","l","y"," " ; only
BYTE (7)"s","y","s","t","e" ; syste
BYTE (7)"m"," ","v","a","r" ; m var
BYTE (7)"i","a","b","l","e" ; iable
BYTE (7)000,000,000,000,000
P.AAT: BYTE (7)"I","n","c","o","r" ; Incor
BYTE (7)"r","e","c","t"," " ; rect
BYTE (7)"o","p","e","r","a" ; opera
BYTE (7)"n","d"," ","t","y" ; nd ty
BYTE (7)"p","e",000,000,000 ; pe
P.AAU: 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)"c","o","n","s","t" ; const
BYTE (7)"a","n","t",000,000 ; ant
P.AAV: BYTE (7)"S","t","a","c","k" ; Stack
BYTE (7)" ","f","u","l","l" ; full
BYTE (7)000,000,000,000,000
PCESOP::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,AC3 ; TYP,AC3
MOVE AC11,AC2 ; OPV,AC2
LDB AC14,C.20 ; OPA,[POINT 15,OPND,35] <0,15>
LDB AC1,C.21 ; AC1,[POINT 2,OPND,19] <16,2>
JRST L.40(AC1) ; L.40(AC1)
L.40: JRST L.41 ; L.41
JRST L.55 ; L.55
JRST L.60 ; L.60
JRST L.62 ; L.62
L.41: IMULI AC14,2 ; OPA,2
ADD AC14,CURSMT ; AC14,CURSMT
LDB AC1,C.13 ; AC1,[POINT 1,0(AC14),6] <29,1>
CAMN AC1,AC13 ; AC1,TYP
JRST L.42 ; L.42
MOVEI AC1,P.AAM ; AC1,P.AAM
PUSHJ SP,PCEERR ; SP,PCEERR
L.42: LDB AC1,C.14 ; AC1,[POINT 3,0(AC14),5] <30,3>
JRST L.43(AC1) ; L.43(AC1)
L.43: JRST L.44 ; L.44
JRST L.45 ; L.45
JRST L.52 ; L.52
JRST L.54 ; L.54
JRST L.54 ; L.54
L.44: MOVE AC2,FP ; AC2,FP
HRRE AC1,0(AC14) ; AC1,0(STE)
ADD AC2,AC1 ; AC2,AC1
MOVE AC1,PCSTAK(AC2) ; OLD,PCSTAK(AC2)
MOVEM AC11,PCSTAK(AC2) ; OPV,PCSTAK(AC2)
CAIE AC13,1 ; TYP,1
JRST L.64 ; L.64
JRST L.51 ; L.51
L.45: MOVE AC1,1(AC14) ; AC1,1(STE)
ADD AC1,CURCNS ; AC1,CURCNS
SETZ AC2, ; AC2,
PUSHJ SP,PCIFGS ; SP,PCIFGS
MOVE AC14,AC1 ; GST,AC1
JUMPL AC14,L.46 ; GST,L.46
LDB AC1,C.15 ; AC1,[POINT 3,0(AC14),4] <31,3>
CAIE AC1,2 ; AC1,2
SETO AC14, ; GST,
L.46: JUMPGE AC14,L.47 ; GST,L.47
MOVEI AC1,P.AAN ; AC1,P.AAN
PUSHJ SP,PCEERR ; SP,PCEERR
L.47: LDB AC1,C.16 ; AC1,[POINT 1,0(AC14),5] <30,1>
CAMN AC1,AC13 ; AC1,TYP
JRST L.48 ; L.48
MOVEI AC1,P.AAO ; AC1,P.AAO
PUSHJ SP,PCEERR ; SP,PCEERR
L.48: ADDI AC14,1 ; GST,1
JUMPN AC13,L.49 ; TYP,L.49
MOVEM AC11,0(AC14) ; OPV,0(AC14)
JRST L.64 ; L.64
L.49: MOVE AC12,0(AC14) ; STRO,0(AC14)
JUMPE AC12,L.50 ; STRO,L.50
HLRZ AC1,AC12 ; AC1,STRO
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,0(AC12) ; AC2,0(STRO)
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
SETZM 0(AC14) ; 0(AC14)
L.50: MOVE AC13,AC11 ; NEWV,OPV
JUMPE AC13,L.64 ; NEWV,L.64
HLRZ AC1,AC13 ; AC1,NEWV
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,XDICT ; AC2,XDICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
MOVE AC12,AC1 ; STRO,AC1
HLL AC12,AC13 ; STRO,NEWV
HLRZ AC1,AC13 ; AC1,NEWV
ADDI AC1,1 ; AC1,1
MOVEI AC2,0(AC13) ; HLF,0(NEWV)
HRLI AC2,-337100 ; HLF,-337100
MOVEI AC5,0(AC12) ; HLF,0(STRO)
HRLI AC5,-337100 ; HLF,-337100
MOVE AC4,AC1 ; AC4,AC1
EXTEND AC1,C.22 ; AC1,[MOVSLJ ]
JFCL ;
MOVEM AC12,0(AC14) ; STRO,0(AC14)
MOVE AC1,AC13 ; AC1,NEWV
L.51: PUSHJ SP,PCEFST ; SP,PCEFST
JRST L.64 ; L.64
L.52: MOVE AC1,FP ; AC1,FP
HRRE AC2,0(AC14) ; AC2,0(STE)
ADD AC1,AC2 ; AC1,AC2
MOVE AC12,PCSTAK(AC1) ; OPN,PCSTAK(AC1)
LDB AC1,C.12 ; AC1,[POINT 2,AC12,19] <16,2>
CAIE AC1,3 ; AC1,3
JRST L.53 ; L.53
MOVEI AC1,P.AAP ; AC1,P.AAP
PUSHJ SP,PCEERR ; SP,PCEERR
L.53: MOVE AC1,FP ; AC1,FP
MOVE AC14,AC1 ; SAVEFP,AC1
MOVE AC10,CURGST ; SAVEGS,CURGST
HRRZ AC2,PCSTAK+1(AC1) ; AC2,PCSTAK+1(AC1)
MOVEM AC2,CURGST ; AC2,CURGST
MOVE AC1,FP ; AC1,FP
HLRZ AC2,PCSTAK(AC1) ; AC2,PCSTAK(AC1)
MOVEM AC2,FP ; AC2,FP
PUSHJ SP,SETCTX ; SP,SETCTX
MOVE AC1,AC12 ; AC1,OPN
MOVE AC2,AC11 ; AC2,OPV
MOVE AC3,AC13 ; AC3,TYP
PUSHJ SP,PCESOP ; SP,PCESOP
MOVEM AC14,FP ; SAVEFP,FP
MOVEM AC10,CURGST ; SAVEGS,CURGST
PUSHJ SP,SETCTX ; SP,SETCTX
JRST L.64 ; L.64
L.54: MOVEI AC1,P.AAQ ; AC1,P.AAQ
JRST L.61 ; L.61
L.55: IMULI AC14,2 ; OPA,2
LDB AC1,C.17 ; AC1,[POINT 3,PSDEFN(AC14),17] <18,3>
CAIN AC1,2 ; AC1,2
JRST L.56 ; L.56
MOVEI AC1,P.AAR ; AC1,P.AAR
PUSHJ SP,PCEERR ; SP,PCEERR
L.56: MOVSI AC1,200000 ; AC1,200000
TDNE AC1,PSDEFN(AC14) ; AC1,PSDEFN(AC14)
JRST L.57 ; L.57
MOVEI AC1,P.AAS ; AC1,P.AAS
PUSHJ SP,PCEERR ; SP,PCEERR
L.57: LDB AC1,C.18 ; AC1,[POINT 3,PSDEFN(AC14),14] <21,3>
CAMN AC1,AC13 ; AC1,TYP
JRST L.58 ; L.58
MOVEI AC1,P.AAT ; AC1,P.AAT
PUSHJ SP,PCEERR ; SP,PCEERR
L.58: HRRZ AC3,PSDEFN+1(AC14) ; AC3,PSDEFN+1(AC14)
SKIPL PSDEFN(AC14) ; PSDEFN(AC14)
JRST L.59 ; L.59
MOVE AC1,AC11 ; AC1,OPV
SETO AC2, ; AC2,
PUSHJ SP,0(AC3) ; SP,0(AC3)
JRST L.64 ; L.64
L.59: MOVEM AC11,0(AC3) ; OPV,0(AC3)
JRST L.64 ; L.64
L.60: MOVEI AC1,P.AAU ; AC1,P.AAU
L.61: PUSHJ SP,PCEERR ; SP,PCEERR
JRST L.64 ; L.64
L.62: MOVE AC1,STKP ; AC1,STKP
CAME AC1,C.23 ; AC1,[<PCSTKL*1000>]
JRST L.63 ; L.63
MOVEI AC1,P.AAV ; AC1,P.AAV
PUSHJ SP,PCEERR ; SP,PCEERR
L.63: AOS AC1,STKP ; AC1,STKP
MOVEM AC11,PCSTAK(AC1) ; OPV,PCSTAK(AC1)
L.64: 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.20: POINT 15,AC1,35 ; 15,OPND,35
C.21: POINT 2,AC1,19 ; 2,OPND,19
C.22: MOVSLJ ;
C.23: EXP <PCSTKL*1000> ; <PCSTKL*1000>
; Routine Size: 161 words
; 0807
; 0808 ROUTINE CALPRC: NOVALUE = ! Call another procedure
; 0809
; 0810 !++
; 0811 ! Functional description:
; 0812 ! Called by instruction dispatcher, with PC pointing after CAL
; 0813 ! instruction. Instruction has procedure designator in operand A,
; 0814 ! constant displacement of actual parameter list in operand B,
; 0815 ! result destination descriptor in operand C (if typed procedure).
; 0816 ! This routine distinguishes between system and user procedures:
; 0817 ! for user procedures it checks for stack overflow, compares the actual
; 0818 ! and formal arguments for validity, pushes actual parameter descriptors
; 0819 ! onto the stack after this procedure's variables, pushes fixed fields
; 0820 ! of stack frame onto stack, updates stack and stack frame pointers,
; 0821 ! sets up executer pointers to reference the new procedure, and sets
; 0822 ! the PC to the beginning of the procedure. For system procedures it
; 0823 ! simply invokes the service routine.
; 0824 ! The actual arguments placed on the stack are genuine operand
; 0825 ! descriptors, just as any other descriptors in the context of the
; 0826 ! CALLER's routine. There is a complication, however: temporaries
; 0827 ! are not described by the generic OPN_TMP descriptor alone, but
; 0828 ! additionally by the stack location of the real data word; this
; 0829 ! is feasible because the called routine can never store into a
; 0830 ! temporary anyway.
; 0831 ! If the called procedure returns a value, it will be stored in
; 0832 ! the destination provided in the CAL instruction when the RET
; 0833 ! is executed.
; 0834 !
; 0835 ! Formal parameters:
; 0836 ! None
; 0837 !
; 0838 ! Implicit inputs:
; 0839 ! PC, INSTR, symbol table, global symbol table,
; 0840 ! constants, context pointers
; 0841 !
; 0842 ! Implicit outputs:
; 0843 ! Stack, FP, SP, context pointers
; 0844 !
; 0845 ! Routine value:
; 0846 ! None
; 0847 !
; 0848 ! Side effects:
; 0849 ! None
; 0850 !
; 0851 !--
; 0852
; 0853 BEGIN
; 0854 EXTERNAL REGISTER Z;
; 0855 LOCAL
; 0856 GST: REF GST_BLK, ! Global symbol table entry
; 0857 IDX, ! Symbol table index
; 0858 ARGI, ! Actual argument pointers
; 0859 ARGJ,
; 0860 NSPTR, ! New stack pointer
; 0861 TMPIDX, ! Stack index for allocating temporaries
; 0862 CNT; ! Argument count
; 0863 IDX = .INSTR[COD_OPA];
; 0864 GST = PCIFGS(.CURSMT[.IDX,STE_NAM]+.CURCNS,.PCCURC[ECB_PSV]);
; 0865 IF .GST GEQ 0
; 0866 THEN
; 0867 IF .GST[GST_CLS] NEQ GST_CLS_PRC AND .GST[GST_CLS] NEQ GST_CLS_FCN
; 0868 THEN
; 0869 GST = -1;
; 0870 IF .GST LSS 0
; 0871 THEN
; 0872 PCEERR( UPLIT(%ASCIZ 'Undefined procedure: #1'),
; 0873 .CURSMT[.IDX,STE_NMA]+.CURCNS);
; 0874 IF .STKP + FRM_LOC + .GST[GST_SLN] GTR STAKLN
; 0875 THEN
; 0876 ERROR('Stack full');
; 0877 ARGI = .INSTR[COD_OPB];
; 0878 IF .ARGI EQL %O'777777' THEN CNT = 0 ELSE CNT = .CURCNS[.ARGI];
; 0879 IF .CNT NEQ .GST[GST_PCT] THEN ERROR('Argument count mismatch');
; 0880 %( The check for type mismatch is missing. Nobody references ARGJ at all )%
; 0881 ARGJ = .GST[GST_TXT] + .GST[GST_COD];
; 0882 ARGI = .ARGI + .CURCNS + .CNT;
; 0883 NSPTR = .STKP + .CNT + 1;
; 0884 TMPIDX = .STKP;
; 0885 ! This is a DECR because any temporaries MUST BE PUSHED IN THIS ORDER
; 0886 DECR I FROM .CNT-1 DO
; 0887 BEGIN
; 0888 LOCAL
; 0889 OPN: OPRAND; ! Operand descriptor
; 0890 NSPTR = .NSPTR - 1;
; 0891 OPN[OPN_WRD] = ..ARGI;
; 0892 IF .OPN[OPN_CLS] EQL OPN_CLS_TMP
; 0893 THEN
; 0894 BEGIN
; 0895 OPN[OPN_ADR] = .TMPIDX;
; 0896 TMPIDX = .TMPIDX - 1
; 0897 END;
; 0898 ARGI = .ARGI - 1;
; 0899 PCSTAK[.NSPTR,FRM_WRD] = .OPN[OPN_WRD]
; 0900 END;
; 0901 NSPTR = .STKP + .CNT + 1;
; 0902 PCSTAK[.NSPTR,FRM_RET] = .PC;
; 0903 PCSTAK[.NSPTR,FRM_PRV] = .FP;
; 0904 PCSTAK[.NSPTR,FRM_STK] = .NSPTR - 1 - .CNT;
; 0905 PCSTAK[.NSPTR,FRM_PRC] = .CURGST;
; 0906 FP = .NSPTR;
; 0907 STKP = .NSPTR + FRM_LOC + .GST[GST_SLN];
; 0908 CURGST = .GST;
; 0909 SETCTX();
; 0910 DECR I FROM .GST[GST_SLN]-1 DO
; 0911 BEGIN
; 0912 PCSTAK[.NSPTR+FRM_LOC,FRM_WRD] = 0;
; 0913 NSPTR = .NSPTR + 1
; 0914 END;
; 0915 PC = 0
; 0916 END;
P.AAW: BYTE (7)"U","n","d","e","f" ; Undef
BYTE (7)"i","n","e","d"," " ; ined
BYTE (7)"p","r","o","c","e" ; proce
BYTE (7)"d","u","r","e",":" ; dure:
BYTE (7)" ","#","1",000,000 ; #1
P.AAX: BYTE (7)"S","t","a","c","k" ; Stack
BYTE (7)" ","f","u","l","l" ; full
BYTE (7)000,000,000,000,000
P.AAY: BYTE (7)"A","r","g","u","m" ; Argum
BYTE (7)"e","n","t"," ","c" ; ent c
BYTE (7)"o","u","n","t"," " ; ount
BYTE (7)"m","i","s","m","a" ; misma
BYTE (7)"t","c","h",000,000 ; tch
CALPRC: PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
HRRZ AC2,INSTR ; IDX,INSTR
MOVE AC1,CURSMT ; AC1,CURSMT
MOVE AC11,AC2 ; AC11,IDX
IMULI AC11,2 ; AC11,2
ADD AC1,AC11 ; AC1,AC11
MOVE AC1,1(AC1) ; AC1,1(AC1)
ADD AC1,CURCNS ; AC1,CURCNS
MOVE AC3,PCCURC ; AC3,PCCURC
LDB AC2,C.24 ; AC2,[POINT 1,12(AC3),0] <35,1>
PUSHJ SP,PCIFGS ; SP,PCIFGS
MOVE AC13,AC1 ; GST,AC1
JUMPL AC13,L.65 ; GST,L.65
LDB AC1,C.25 ; AC1,[POINT 3,0(GST),4] <31,3>
CAIE AC1,1 ; AC1,1
CAIN AC1,3 ; AC1,3
JRST L.65 ; L.65
SETO AC13, ; GST,
L.65: JUMPGE AC13,L.66 ; GST,L.66
MOVE AC2,CURSMT ; AC2,CURSMT
ADD AC2,AC11 ; AC2,AC11
HRRZ AC2,1(AC2) ; AC2,1(AC2)
ADD AC2,CURCNS ; AC2,CURCNS
MOVEI AC1,P.AAW ; AC1,P.AAW
PUSHJ SP,PCEERR ; SP,PCEERR
L.66: MOVE AC1,STKP ; AC1,STKP
LDB AC2,C.26 ; AC2,[POINT 8,0(GST),17] <18,8>
ADD AC1,AC2 ; AC1,AC2
ADDI AC1,2 ; AC1,2
CAMG AC1,C.29 ; AC1,[<PCSTKL*1000>]
JRST L.67 ; L.67
MOVEI AC1,P.AAX ; AC1,P.AAX
PUSHJ SP,PCEERR ; SP,PCEERR
L.67: HLRZ AC11,INSTR+1 ; ARGI,INSTR+1
CAIE AC11,-1 ; ARGI,-1
JRST L.68 ; L.68
SETZ AC12, ; CNT,
JRST L.69 ; L.69
L.68: MOVE AC1,CURCNS ; AC1,CURCNS
ADD AC1,AC11 ; AC1,ARGI
MOVE AC12,0(AC1) ; CNT,0(AC1)
L.69: LDB AC1,C.27 ; AC1,[POINT 4,0(GST),9] <26,4>
CAMN AC12,AC1 ; CNT,AC1
JRST L.70 ; L.70
MOVEI AC1,P.AAY ; AC1,P.AAY
PUSHJ SP,PCEERR ; SP,PCEERR
L.70: HRRZ AC1,0(AC13) ; ARGJ,0(GST)
LDB AC2,C.28 ; AC2,[POINT 12,1(GST),35] <0,12>
ADD AC1,AC2 ; ARGJ,AC2
MOVE AC1,AC11 ; AC1,ARGI
ADD AC1,CURCNS ; AC1,CURCNS
MOVE AC11,AC1 ; ARGI,AC1
ADD AC11,AC12 ; ARGI,CNT
MOVE AC1,STKP ; AC1,STKP
ADD AC1,AC12 ; AC1,CNT
MOVE AC14,AC1 ; NSPTR,AC1
ADDI AC14,1 ; NSPTR,1
MOVE AC2,STKP ; TMPIDX,STKP
MOVE AC3,AC12 ; I,CNT
JRST L.73 ; L.73
L.71: SUBI AC14,1 ; NSPTR,1
MOVE AC1,0(AC11) ; OPN,0(ARGI)
LDB AC4,C.21 ; AC4,[POINT 2,AC1,19] <16,2>
CAIE AC4,3 ; AC4,3
JRST L.72 ; L.72
DPB AC2,C.20 ; TMPIDX,[POINT 15,AC1,35] <0,15>
SUBI AC2,1 ; TMPIDX,1
L.72: SUBI AC11,1 ; ARGI,1
MOVEM AC1,PCSTAK(AC14) ; OPN,PCSTAK(NSPTR)
L.73: SOJGE AC3,L.71 ; I,L.71
MOVE AC1,STKP ; AC1,STKP
ADD AC1,AC12 ; AC1,CNT
MOVE AC14,AC1 ; NSPTR,AC1
ADDI AC14,1 ; NSPTR,1
MOVE AC1,PC ; AC1,PC
HRRM AC1,PCSTAK(AC14) ; AC1,PCSTAK(NSPTR)
MOVE AC1,FP ; AC1,FP
HRLM AC1,PCSTAK(AC14) ; AC1,PCSTAK(NSPTR)
MOVE AC1,AC14 ; AC1,NSPTR
SUB AC1,AC12 ; AC1,CNT
SUBI AC1,1 ; AC1,1
HRLM AC1,PCSTAK+1(AC14) ; AC1,PCSTAK+1(NSPTR)
MOVE AC1,CURGST ; AC1,CURGST
HRRM AC1,PCSTAK+1(AC14) ; AC1,PCSTAK+1(NSPTR)
MOVEM AC14,FP ; NSPTR,FP
MOVE AC1,AC14 ; AC1,NSPTR
LDB AC2,C.26 ; AC2,[POINT 8,0(GST),17] <18,8>
ADD AC1,AC2 ; AC1,AC2
ADDI AC1,2 ; AC1,2
MOVEM AC1,STKP ; AC1,STKP
MOVEM AC13,CURGST ; GST,CURGST
PUSHJ SP,SETCTX ; SP,SETCTX
LDB AC1,C.26 ; I,[POINT 8,0(GST),17] <18,8>
JRST L.75 ; L.75
L.74: SETZM PCSTAK+2(AC14) ; PCSTAK+2(NSPTR)
ADDI AC14,1 ; NSPTR,1
L.75: SOJGE AC1,L.74 ; I,L.74
SETZM PC ; PC
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POPJ SP, ; SP,
C.24: POINT 1,12(AC3),0 ; 1,12(AC3),0
C.25: POINT 3,0(AC13),4 ; 3,0(GST),4
C.26: POINT 8,0(AC13),17 ; 8,0(GST),17
C.27: POINT 4,0(AC13),9 ; 4,0(GST),9
C.28: POINT 12,1(AC13),35 ; 12,1(GST),35
C.29: EXP <PCSTKL*1000> ; <PCSTKL*1000>
; Routine Size: 112 words
; 0917
; 0918 ROUTINE RETPRC: NOVALUE = ! Return from procedure
; 0919
; 0920 !++
; 0921 ! Functional description:
; 0922 ! Unwinds stack frame to reference calling procedure, resets
; 0923 ! context to caller, and continues. If caller expected a value,
; 0924 ! returned value is deposited.
; 0925 !
; 0926 ! Formal parameters:
; 0927 ! None
; 0928 !
; 0929 ! Implicit inputs:
; 0930 ! FP, stack frame
; 0931 !
; 0932 ! Implicit outputs:
; 0933 ! Stack frame pointer, PC, CURGST
; 0934 !
; 0935 ! Routine value:
; 0936 ! None
; 0937 !
; 0938 ! Side effects:
; 0939 ! Frees string variables in the called routine's stack frame
; 0940 !
; 0941 !--
; 0942
; 0943 BEGIN
; 0944 EXTERNAL REGISTER Z;
; 0945 LOCAL
; 0946 FPTR, ! Copy of frame pointer in a register
; 0947 LSP: REF BLOCK[1] FIELD(FRM_FLD), ! Local stack pointer
; 0948 OPN: OPRAND, ! Operand descriptor
; 0949 CNT, ! Argument count
; 0950 CLS, ! Class of returning routine
; 0951 VAL; ! Returned value
; 0952 CLS = .CURGST[GST_CLS];
; 0953 IF .CLS EQL GST_CLS_FCN
; 0954 THEN
; 0955 IF .CURGST[GST_TYP] EQL GST_TYP_INT
; 0956 THEN
; 0957 VAL = PCEGOP(.INSTR[COD_OPA],STE_TYP_INT)
; 0958 ELSE
; 0959 BEGIN
; 0960 VAL = PCEGOP(.INSTR[COD_OPA],STE_TYP_STR);
; 0961 IF .INSTR[COD_OPA] NEQ OPN_TMP_STR THEN VAL = PCECST(.VAL)
; 0962 END;
; 0963 CLNVAR();
; 0964 FPTR = .FP;
; 0965 CNT = .CURGST[GST_PCT];
; 0966 PC = .PCSTAK[.FPTR,FRM_RET];
; 0967 CURGST = .PCSTAK[.FPTR,FRM_PRC];
; 0968 STKP = .PCSTAK[.FPTR,FRM_STK];
; 0969 FP = .PCSTAK[.FPTR,FRM_PRV];
; 0970 SETCTX();
; 0971 LSP = PCSTAK[.STKP,FRM_WRD];
; 0972 DECR I FROM .CNT-1 DO
; 0973 BEGIN
; 0974 LSP = .LSP + 1;
; 0975 OPN[OPN_WRD] = .LSP[FRM_WRD];
; 0976 IF .OPN[OPN_CLS] EQL OPN_CLS_TMP
; 0977 THEN
; 0978 BEGIN
; 0979 IF .OPN[OPN_STR]
; 0980 THEN
; 0981 BEGIN
; 0982 OPN[OPN_WRD] = .OPN[OPN_ADR];
; 0983 PCEFST(.PCSTAK[.OPN[OPN_WRD],FRM_WRD])
; 0984 END;
; 0985 IF .STKP EQL PCEOWN
; 0986 THEN
; 0987 ERROR('PCL internal error - stack underflow');
; 0988 STKP = .STKP - 1
; 0989 END
; 0990 END;
; 0991 IF .CLS EQL GST_CLS_FCN
; 0992 THEN
; 0993 BEGIN
; 0994 OPN[OPN_WRD] = .CURCOD[.PC-2,COD_OPC];
; 0995 PCESOP(.OPN[OPN_WRD], .VAL, STE_TYP_STR)
; 0996 END
; 0997 END;
P.AAZ: BYTE (7)"P","C","L"," ","i" ; PCL i
BYTE (7)"n","t","e","r","n" ; ntern
BYTE (7)"a","l"," ","e","r" ; al er
BYTE (7)"r","o","r"," ","-" ; ror -
BYTE (7)" ","s","t","a","c" ; stac
BYTE (7)"k"," ","u","n","d" ; k und
BYTE (7)"e","r","f","l","o" ; erflo
BYTE (7)"w",000,000,000,000 ; w
RETPRC: 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 AC2,CURGST ; AC2,CURGST
LDB AC1,C.30 ; CLS,[POINT 3,0(AC2),4] <31,3>
SETZ AC11, ; AC11,
CAIE AC1,3 ; CLS,3
JRST L.78 ; L.78
MOVEI AC11,1 ; AC11,1
LDB AC1,C.31 ; AC1,[POINT 1,0(AC2),5] <30,1>
JUMPN AC1,L.76 ; AC1,L.76
HRRZ AC1,INSTR ; AC1,INSTR
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
JRST L.77 ; L.77
L.76: HRRZ AC1,INSTR ; AC1,INSTR
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC10,AC1 ; VAL,AC1
HRRZ AC1,INSTR ; AC1,INSTR
CAIN AC1,-100000 ; AC1,-100000
JRST L.78 ; L.78
MOVE AC1,AC10 ; AC1,VAL
PUSHJ SP,PCECST ; SP,PCECST
L.77: MOVE AC10,AC1 ; VAL,AC1
L.78: PUSHJ SP,CLNVAR ; SP,CLNVAR
MOVE AC1,FP ; FPTR,FP
MOVE AC2,CURGST ; AC2,CURGST
LDB AC14,C.32 ; CNT,[POINT 4,0(AC2),9] <26,4>
HRRZ AC2,PCSTAK(AC1) ; AC2,PCSTAK(FPTR)
MOVEM AC2,PC ; AC2,PC
HRRZ AC2,PCSTAK+1(AC1) ; AC2,PCSTAK+1(FPTR)
MOVEM AC2,CURGST ; AC2,CURGST
HLRZ AC2,PCSTAK+1(AC1) ; AC2,PCSTAK+1(FPTR)
MOVEM AC2,STKP ; AC2,STKP
HLRZ AC2,PCSTAK(AC1) ; AC2,PCSTAK(FPTR)
MOVEM AC2,FP ; AC2,FP
PUSHJ SP,SETCTX ; SP,SETCTX
MOVE AC13,STKP ; LSP,STKP
ADDI AC13,PCSTAK ; LSP,PCSTAK
JRST L.82 ; L.82
L.79: ADDI AC13,1 ; LSP,1
MOVE AC12,0(AC13) ; OPN,0(LSP)
LDB AC1,C.12 ; AC1,[POINT 2,AC12,19] <16,2>
CAIE AC1,3 ; AC1,3
JRST L.82 ; L.82
TRNN AC12,100000 ; OPN,100000
JRST L.80 ; L.80
ANDI AC12,77777 ; OPN,77777
MOVE AC1,PCSTAK(AC12) ; AC1,PCSTAK(OPN)
PUSHJ SP,PCEFST ; SP,PCEFST
L.80: MOVEI AC1,15 ; AC1,15
CAME AC1,STKP ; AC1,STKP
JRST L.81 ; L.81
MOVEI AC1,P.AAZ ; AC1,P.AAZ
PUSHJ SP,PCEERR ; SP,PCEERR
L.81: SOS STKP ; STKP
L.82: SOJGE AC14,L.79 ; I,L.79
TRNN AC11,1 ; AC11,1
JRST L.83 ; L.83
MOVE AC1,CURCOD ; AC1,CURCOD
MOVE AC2,PC ; AC2,PC
ADD AC1,AC2 ; AC1,AC2
HRRZ AC12,-1(AC1) ; OPN,-1(AC1)
MOVE AC1,AC12 ; AC1,OPN
MOVE AC2,AC10 ; AC2,VAL
MOVEI AC3,1 ; AC3,1
PUSHJ SP,PCESOP ; SP,PCESOP
L.83: 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.30: POINT 3,0(AC2),4 ; 3,0(AC2),4
C.31: POINT 1,0(AC2),5 ; 1,0(AC2),5
C.32: POINT 4,0(AC2),9 ; 4,0(AC2),9
; Routine Size: 79 words
; 0998
; 0999 ROUTINE DOCASE: NOVALUE = ! Indexed jump
; 1000
; 1001 !++
; 1002 ! Functional description:
; 1003 ! Using integer A is index, jump to A'th code index in table B,
; 1004 ! which is C(B) words long, biasing each index by constant indexed
; 1005 ! by C. If A is outside the range, jump to the C(B)-1'th code index
; 1006 ! unless C(B)-1 EQL -1 (ie, no OUTRANGE was specified), in which case
; 1007 ! we abort.
; 1008 !
; 1009 ! Formal parameters:
; 1010 ! None
; 1011 !
; 1012 ! Implicit inputs:
; 1013 ! Instruction, user's operands
; 1014 !
; 1015 ! Implicit outputs:
; 1016 ! PC
; 1017 !
; 1018 ! Routine value:
; 1019 ! None
; 1020 !
; 1021 ! Side effects:
; 1022 ! None
; 1023 !
; 1024 !--
; 1025
; 1026 BEGIN
; 1027 EXTERNAL REGISTER Z;
; 1028 LOCAL
; 1029 IDX, ! Jump index
; 1030 TBL; ! Jump table location
; 1031 IDX = PCEGOP(.INSTR[COD_OPA],STE_TYP_INT);
; 1032 TBL = .INSTR[COD_OPB];
; 1033 IDX = .IDX - .CURCNS[.INSTR[COD_OPC]];
; 1034 IF .IDX LSS 0 OR .IDX GEQ .CURCNS[.TBL] ! Case out of range?
; 1035 THEN
; 1036 BEGIN
; 1037 IF .CURCNS[.TBL-1] NEQ -1 ! Yes, OUTRANGE, specified?
; 1038 THEN
; 1039 PC = .CURCNS[.TBL-1] ! Yes, go to OUTRANGE statement
; 1040 ELSE
; 1041 ERROR('Index outside range') ! Nope, die
; 1042 END
; 1043 ELSE
; 1044 PC = .CURCNS[.TBL+.IDX+1] ! In range, do normal stuff
; 1045 END;
P.ABA: BYTE (7)"I","n","d","e","x" ; Index
BYTE (7)" ","o","u","t","s" ; outs
BYTE (7)"i","d","e"," ","r" ; ide r
BYTE (7)"a","n","g","e",000 ; ange
DOCASE: HRRZ AC1,INSTR ; AC1,INSTR
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
HLRZ AC3,INSTR+1 ; TBL,INSTR+1
MOVE AC4,CURCNS ; AC4,CURCNS
HRRZ AC5,INSTR+1 ; AC5,INSTR+1
MOVE AC2,AC4 ; AC2,AC4
ADD AC2,AC5 ; AC2,AC5
SUB AC1,0(AC2) ; IDX,0(AC2)
JUMPL AC1,L.84 ; IDX,L.84
MOVE AC2,AC4 ; AC2,AC4
ADD AC2,AC3 ; AC2,TBL
CAMGE AC1,0(AC2) ; IDX,0(AC2)
JRST L.86 ; L.86
L.84: MOVE AC2,AC4 ; AC2,AC4
ADD AC2,AC3 ; AC2,TBL
SETO AC1, ; AC1,
CAMN AC1,-1(AC2) ; AC1,-1(AC2)
JRST L.85 ; L.85
MOVE AC1,-1(AC2) ; AC1,-1(AC2)
JRST L.87 ; L.87
L.85: MOVEI AC1,P.ABA ; AC1,P.ABA
JRST PCEERR ; PCEERR
L.86: ADD AC3,AC1 ; TBL,IDX
MOVE AC2,AC4 ; AC2,AC4
ADD AC2,AC3 ; AC2,AC3
MOVE AC1,1(AC2) ; AC1,1(AC2)
L.87: MOVEM AC1,PC ; AC1,PC
POPJ SP, ; SP,
; Routine Size: 29 words
; 1046
; 1047 ROUTINE CLNVAR: NOVALUE = ! Clean up local string variables
; 1048
; 1049 !++
; 1050 ! Functional description:
; 1051 ! Called just before exit from a command or procedure, to
; 1052 ! free all strings contained in local string variables.
; 1053 !
; 1054 ! Formal parameters:
; 1055 ! None
; 1056 !
; 1057 ! Implicit inputs:
; 1058 ! Current symbol table
; 1059 !
; 1060 ! Implicit outputs:
; 1061 ! String pool
; 1062 !
; 1063 ! Routine value:
; 1064 ! None
; 1065 !
; 1066 ! Side effects:
; 1067 ! None
; 1068 !
; 1069 !--
; 1070
; 1071 %( This should take an argument to work its way up the stack frames )%
; 1072 DECR I FROM .CURSML DO
; 1073 IF .CURSMT[.I,STE_VLD] EQL STE_VLD_NUM AND
; 1074 .CURSMT[.I,STE_CLS] EQL STE_CLS_VAR AND
; 1075 .CURSMT[.I,STE_TYP] EQL STE_TYP_STR
; 1076 THEN
; 1077 IF .PCSTAK[.FP+.CURSMT[.I,STE_LOC],FRM_WRD] NEQ 0
; 1078 THEN
; 1079 BEGIN
; 1080 EXTERNAL REGISTER Z;
; 1081 PCEFST(.PCSTAK[.FP+.CURSMT[.I,STE_LOC],FRM_WRD])
; 1082 END;
CLNVAR: PUSH SP,AC14 ; SP,AC14
MOVE AC14,CURSML ; I,CURSML
AOJA AC14,L.89 ; I,L.89
L.88: MOVE AC2,CURSMT ; AC2,CURSMT
MOVE AC1,AC14 ; AC1,I
IMULI AC1,2 ; AC1,2
ADD AC2,AC1 ; AC2,AC1
LDB AC1,C.33 ; AC1,[POINT 3,0(AC2),2] <33,3>
CAIE AC1,2 ; AC1,2
JRST L.89 ; L.89
LDB AC1,C.34 ; AC1,[POINT 3,0(AC2),5] <30,3>
JUMPN AC1,L.89 ; AC1,L.89
LDB AC1,C.35 ; AC1,[POINT 1,0(AC2),6] <29,1>
CAIE AC1,1 ; AC1,1
JRST L.89 ; L.89
MOVE AC1,FP ; AC1,FP
HRRE AC2,0(AC2) ; AC2,0(AC2)
ADD AC1,AC2 ; AC1,AC2
SKIPE AC1,PCSTAK(AC1) ; AC1,PCSTAK(AC1)
PUSHJ SP,PCEFST ; SP,PCEFST
L.89: SOJGE AC14,L.88 ; I,L.88
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
C.33: POINT 3,0(AC2),2 ; 3,0(AC2),2
C.34: POINT 3,0(AC2),5 ; 3,0(AC2),5
C.35: POINT 1,0(AC2),6 ; 1,0(AC2),6
; Routine Size: 26 words
; 1083
; 1084 ROUTINE DOSBSS: NOVALUE = ! Extract substring
; 1085
; 1086 !++
; 1087 ! Functional description:
; 1088 ! Performs SBS instruction: Extracts substring of string C, stores
; 1089 ! substring in A. B points to two constant words, containing
; 1090 ! integer descriptors: First character (starts with 1) and length.
; 1091 ! A length-designator of -1 means to extract to the end of the string.
; 1092 !
; 1093 ! Formal parameters:
; 1094 ! None
; 1095 !
; 1096 ! Implicit inputs:
; 1097 ! Instruction, operands
; 1098 !
; 1099 ! Implicit outputs:
; 1100 ! Instruction operand
; 1101 !
; 1102 ! Routine value:
; 1103 ! None
; 1104 !
; 1105 ! Side effects:
; 1106 ! None
; 1107 !
; 1108 !--
; 1109
; 1110 BEGIN
; 1111 EXTERNAL REGISTER Z;
; 1112 LOCAL
; 1113 OPAV: STR_VAL, ! Stringvalues
; 1114 OPCV: STR_VAL,
; 1115 STRT, ! Character offset
; 1116 LEN; ! Character count
; 1117
; 1118 ! Take care to get the operands in this order; they might be on the stack
; 1119 LEN = .CURCNS[.INSTR[COD_OPB]+1];
; 1120 IF .LEN GEQ 0 THEN LEN = PCEGOP(.LEN,STE_TYP_INT);
; 1121 STRT = PCEGOP(.CURCNS[.INSTR[COD_OPB]],STE_TYP_INT);
; 1122 OPCV = PCEGOP(.INSTR[COD_OPC],STE_TYP_STR);
; 1123 IF .STRT LEQ 0 THEN ERROR('Substring start less than one');
; 1124 IF .LEN EQL -1 THEN LEN = .OPCV[STV_LEN]-.STRT+1;
; 1125 IF .STRT+.LEN-1 GTR .OPCV[STV_LEN] THEN LEN = .OPCV[STV_LEN]-.STRT+1;
; 1126 IF .LEN LSS 1
; 1127 THEN
; 1128 PCESOP(.INSTR[COD_OPA], 0, STE_TYP_STR)
; 1129 ELSE
; 1130 BEGIN
; 1131 OPAV = PCEAST(.LEN);
; 1132 CH$COPY(.LEN, CH$PTR(.OPCV[STV_ADR],.STRT-1),
; 1133 0, .LEN+1, BYTPTR(.OPAV[STV_ADR]));
; 1134 PCESOP(.INSTR[COD_OPA], .OPAV, STE_TYP_STR)
; 1135 END;
; 1136 IF .INSTR[COD_OPC] EQL OPN_TMP_STR THEN PCEFST(.OPCV)
; 1137 END;
P.ABB: BYTE (7)"S","u","b","s","t" ; Subst
BYTE (7)"r","i","n","g"," " ; ring
BYTE (7)"s","t","a","r","t" ; start
BYTE (7)" ","l","e","s","s" ; less
BYTE (7)" ","t","h","a","n" ; than
BYTE (7)" ","o","n","e",000 ; one
DOSBSS: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC1,CURCNS ; AC1,CURCNS
HLRZ AC2,INSTR+1 ; AC2,INSTR+1
ADD AC1,AC2 ; AC1,AC2
MOVE AC13,1(AC1) ; LEN,1(AC1)
JUMPL AC13,L.90 ; LEN,L.90
MOVE AC1,AC13 ; AC1,LEN
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC13,AC1 ; LEN,AC1
L.90: MOVE AC3,CURCNS ; AC3,CURCNS
HLRZ AC1,INSTR+1 ; AC1,INSTR+1
ADD AC3,AC1 ; AC3,AC1
MOVE AC1,0(AC3) ; AC1,0(AC3)
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC14,AC1 ; STRT,AC1
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC12,AC1 ; OPCV,AC1
JUMPG AC14,L.91 ; STRT,L.91
MOVEI AC1,P.ABB ; AC1,P.ABB
PUSHJ SP,PCEERR ; SP,PCEERR
L.91: CAME AC13,C.36 ; LEN,[-1]
JRST L.92 ; L.92
HLRZ AC1,AC12 ; AC1,OPCV
SUB AC1,AC14 ; AC1,STRT
MOVE AC13,AC1 ; LEN,AC1
ADDI AC13,1 ; LEN,1
L.92: MOVE AC1,AC14 ; AC1,STRT
ADD AC1,AC13 ; AC1,LEN
SUBI AC1,1 ; AC1,1
HLRZ AC2,AC12 ; AC2,OPCV
CAMG AC1,AC2 ; AC1,AC2
JRST L.93 ; L.93
HLRZ AC1,AC12 ; AC1,OPCV
SUB AC1,AC14 ; AC1,STRT
MOVE AC13,AC1 ; LEN,AC1
ADDI AC13,1 ; LEN,1
L.93: JUMPG AC13,L.94 ; LEN,L.94
HRRZ AC1,INSTR ; AC1,INSTR
SETZ AC2, ; AC2,
JRST L.95 ; L.95
L.94: MOVE AC1,AC13 ; AC1,LEN
PUSHJ SP,PCEAST ; SP,PCEAST
MOVE AC16,AC1 ; OPAV,AC1
MOVEI AC2,0(AC12) ; AC2,0(OPCV)
MOVE AC1,AC14 ; AC1,STRT
SUBI AC1,1 ; AC1,1
MOVEI AC3,0(AC2) ; AC3,0(AC2)
HRLI AC3,-337100 ; AC3,-337100
MOVE AC2,AC1 ; AC2,AC1
ADJBP AC2,AC3 ; AC2,AC3
MOVE AC3,AC13 ; AC3,LEN
ADDI AC3,1 ; AC3,1
MOVEI AC5,0(AC16) ; HLF,0(OPAV)
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,AC13 ; AC1,LEN
MOVE AC4,AC3 ; AC4,AC3
EXTEND AC1,C.3 ; AC1,C.3
JFCL ;
HRRZ AC1,INSTR ; AC1,INSTR
MOVE AC2,AC16 ; AC2,OPAV
L.95: MOVEI AC3,1 ; AC3,1
PUSHJ SP,PCESOP ; SP,PCESOP
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
CAIE AC1,-100000 ; AC1,-100000
JRST L.96 ; L.96
MOVE AC1,AC12 ; AC1,OPCV
PUSHJ SP,PCEFST ; SP,PCEFST
L.96: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.36: EXP -1 ; -1
; Routine Size: 78 words
; 1138
; 1139 ROUTINE DOCMND = ! DoCommand Statement
; 1140
; 1141 !++
; 1142 ! Functional description:
; 1143 ! Copies string to be performed from A operand to
; 1144 ! Exec's Command Buffer, after pointer CMPTR as
; 1145 ! reported by EXECPM; appends newline. Returns
; 1146 ! number of characters in string inserted. If B
; 1147 ! operand field is zero, sets flag to indicate
; 1148 ! Original mode. If C is not -1, sets up Exec
; 1149 ! to store Exec output into that string variable.
; 1150 ! If string contains more than one line, generates
; 1151 ! string block containing remaining lines.
; 1152 !
; 1153 ! Formal parameters:
; 1154 ! None
; 1155 !
; 1156 ! Implicit inputs:
; 1157 ! Instruction being executed
; 1158 !
; 1159 ! Implicit outputs:
; 1160 ! Exec Command Buffer
; 1161 !
; 1162 ! Routine value:
; 1163 ! Number of characters copied
; 1164 !
; 1165 ! Side effects:
; 1166 ! None
; 1167 !
; 1168 !--
; 1169
; 1170 BEGIN
; 1171 EXTERNAL REGISTER Z;
; 1172 LOCAL
; 1173 OPND: STR_VAL, ! Operand descriptor
; 1174 PTRI, ! String pointers
; 1175 PTRO,
; 1176 ICNT, ! Characters inserted
; 1177 CHR; ! Character
; 1178 IF .PCCURC[ECB_PAR] NEQ 0
; 1179 THEN
; 1180 BEGIN
; 1181 IF PCIPRS(CFM_FLDDB,0) LSS 0 THEN PCMPER(0);
; 1182 PCCURC[ECB_PAR] = 0
; 1183 END;
; 1184 PCLDCO = 0;
; 1185 IF .INSTR[COD_OPB] EQL 0
; 1186 THEN
; 1187 IF .PCCURC[ECB_PSV] THEN PCLDCO = 1 ELSE PCLDCO = -1;
; 1188 IF (PCCURC[ECB_DTO] = .INSTR[COD_OPC]) NEQ %O'777777' THEN PCIPEO();
; 1189 OPND = PCEGOP(.INSTR[COD_OPA],STE_TYP_STR);
; 1190 PTRI = BYTPTR(.OPND[STV_ADR]);
; 1191 PTRO = .CMPTR;
; 1192 ICNT = 0;
; 1193 IF .OPND[STV_LEN] NEQ 0 THEN
; 1194 WHILE 1 DO
; 1195 BEGIN
; 1196 CHR = CH$RCHAR_A(PTRI);
; 1197 IF .CHR EQL $CHNUL THEN EXITLOOP;
; 1198 IF .CHR EQL $CHCRT
; 1199 THEN
; 1200 BEGIN
; 1201 LOCAL
; 1202 BLK: REF STB_BLK, ! String block
; 1203 SCNT, ! Characters skipped
; 1204 LEN;
; 1205 SCNT = .ICNT + 1;
; 1206 IF (CHR = CH$RCHAR(.PTRI)) EQL $CHLFD
; 1207 THEN
; 1208 BEGIN
; 1209 CHR = CH$RCHAR_A(PTRI);
; 1210 SCNT = .SCNT + 1
; 1211 END;
; 1212 IF .CHR EQL $CHNUL THEN EXITLOOP;
; 1213 LEN = (.OPND[STV_LEN] - .SCNT + 9)/5;
; 1214 BLK = PCMGMM(.LEN, XDICT);
; 1215 BLK[STB_CNT] = .OPND[STV_LEN] - .SCNT;
; 1216 BLK[STB_LEN] = .LEN;
; 1217 PCCURC[ECB_DCB] = .BLK;
; 1218 CH$MOVE(.BLK[STB_CNT], .PTRI, BYTPTR(BLK[STB_BUF]));
; 1219 EXITLOOP
; 1220 END
; 1221 ELSE
; 1222 BEGIN
; 1223 CH$WCHAR_A(.CHR,PTRO);
; 1224 ICNT = .ICNT + 1
; 1225 END
; 1226 END;
; 1227 IF .INSTR[COD_OPA] EQL OPN_TMP_STR THEN PCEFST(.OPND);
; 1228 CH$WCHAR_A($CHCRT,PTRO);
; 1229 CH$WCHAR_A($CHLFD,PTRO);
; 1230 CH$WCHAR_A($CHNUL,PTRO);
; 1231 .ICNT + 2
; 1232 END;
DOCMND: 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
MOVE AC1,PCCURC ; AC1,PCCURC
LDB AC2,C.37 ; AC2,[POINT 1,12(AC1),5] <30,1>
JUMPE AC2,L.98 ; AC2,L.98
MOVEI AC1,CFM_FLDDB ; AC1,CFM_FLDDB
SETZ AC2, ; AC2,
PUSHJ SP,PCIPRS ; SP,PCIPRS
JUMPGE AC1,L.97 ; AC1,L.97
SETZ AC1, ; AC1,
PUSHJ SP,PCMPER ; SP,PCMPER
L.97: MOVE AC1,PCCURC ; AC1,PCCURC
MOVSI AC2,10000 ; AC2,10000
ANDCAM AC2,12(AC1) ; AC2,12(AC1)
L.98: SETZM PCLDCO ; PCLDCO
HLRZ AC1,INSTR+1 ; AC1,INSTR+1
JUMPN AC1,L.100 ; AC1,L.100
MOVE AC1,PCCURC ; AC1,PCCURC
SKIPL 12(AC1) ; 12(AC1)
JRST L.99 ; L.99
MOVEI AC1,1 ; AC1,1
MOVEM AC1,PCLDCO ; AC1,PCLDCO
JRST L.100 ; L.100
L.99: SETOM PCLDCO ; PCLDCO
L.100: MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC2,INSTR+1 ; AC2,INSTR+1
HRLM AC2,6(AC1) ; AC2,6(AC1)
CAIE AC2,-1 ; AC2,-1
PUSHJ SP,PCIPEO ; SP,PCIPEO
HRRZ AC1,INSTR ; AC1,INSTR
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,-1(SP) ; AC1,OPND
HRRZ AC1,-1(SP) ; HLF,OPND
HRLI AC1,-337100 ; HLF,-337100
MOVE AC11,AC1 ; PTRI,HLF
MOVE AC10,CMPTR ; PTRO,CMPTR
SETZM 0(SP) ; ICNT
HLRZ AC1,-1(SP) ; AC1,OPND
JUMPE AC1,L.104 ; AC1,L.104
L.101: ILDB AC13,AC11 ; CHR,PTRI
JUMPE AC13,L.104 ; CHR,L.104
CAIE AC13,15 ; CHR,15
JRST L.103 ; L.103
MOVE AC1,0(SP) ; SCNT,ICNT
ADDI AC1,1 ; SCNT,1
MOVE AC2,AC11 ; AC2,PTRI
ILDB AC13,AC2 ; CHR,AC2
CAIE AC13,12 ; CHR,12
JRST L.102 ; L.102
ILDB AC13,AC11 ; CHR,PTRI
ADDI AC1,1 ; SCNT,1
L.102: JUMPE AC13,L.104 ; CHR,L.104
HLRZ AC14,-1(SP) ; AC14,OPND
SUB AC14,AC1 ; AC14,SCNT
MOVE AC1,AC14 ; AC1,AC14
ADDI AC1,11 ; AC1,11
IDIVI AC1,5 ; AC1,5
MOVE AC12,AC1 ; LEN,AC1
MOVEI AC2,XDICT ; AC2,XDICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
MOVE AC3,AC1 ; BLK,AC1
HRLM AC14,0(AC3) ; AC14,0(BLK)
HRRM AC12,0(AC3) ; LEN,0(BLK)
MOVE AC1,PCCURC ; AC1,PCCURC
HRRM AC3,6(AC1) ; BLK,6(AC1)
MOVE AC5,AC3 ; HLF,BLK
ADDI AC5,1 ; HLF,1
HRLI AC5,-337100 ; HLF,-337100
HLRZ AC1,0(AC3) ; AC1,0(BLK)
MOVE AC2,AC11 ; AC2,PTRI
HLRZ AC4,0(AC3) ; AC4,0(BLK)
EXTEND AC1,C.22 ; AC1,[MOVSLJ ]
JFCL ;
JRST L.104 ; L.104
L.103: IDPB AC13,AC10 ; CHR,PTRO
AOS 0(SP) ; ICNT
JRST L.101 ; L.101
L.104: HRRZ AC1,INSTR ; AC1,INSTR
CAIE AC1,-100000 ; AC1,-100000
JRST L.105 ; L.105
MOVE AC1,-1(SP) ; AC1,OPND
PUSHJ SP,PCEFST ; SP,PCEFST
L.105: MOVEI AC1,15 ; AC1,15
IDPB AC1,AC10 ; AC1,PTRO
MOVEI AC1,12 ; AC1,12
IDPB AC1,AC10 ; AC1,PTRO
SETZ AC1, ; AC1,
IDPB AC1,AC10 ; AC1,PTRO
MOVE AC1,0(SP) ; AC1,ICNT
ADDI AC1,2 ; AC1,2
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.37: POINT 1,12(AC1),5 ; 1,12(AC1),5
; Routine Size: 103 words
; 1233
; 1234 ROUTINE PUTDCL = ! Send additional DoCommand line
; 1235
; 1236 !++
; 1237 ! Functional description:
; 1238 ! Pass additional DoCommand lines to Exec from string block
; 1239 ! saved in ECB.
; 1240 !
; 1241 ! Formal parameters:
; 1242 ! None
; 1243 !
; 1244 ! Implicit inputs:
; 1245 ! Execution Context Block
; 1246 !
; 1247 ! Implicit outputs:
; 1248 ! Command string, Execution Context Block
; 1249 !
; 1250 ! Routine value:
; 1251 ! Number of characters inserted
; 1252 !
; 1253 ! Side effects:
; 1254 ! None
; 1255 !
; 1256 !--
; 1257
; 1258 BEGIN
; 1259 EXTERNAL REGISTER Z;
; 1260 LOCAL
; 1261 BLK: REF STB_BLK, ! String block
; 1262 PTRI, ! String pointers
; 1263 PTRO,
; 1264 ICNT, ! Characters inserted
; 1265 RCNT, ! Characters remaining in string
; 1266 CHR;
; 1267
; 1268 BLK = .PCCURC[ECB_DCB];
; 1269 PCCURC[ECB_DCB] = 0;
; 1270 ICNT = 0;
; 1271 PTRI = BYTPTR(BLK[STB_BUF]);
; 1272 PTRO = .CMPTR;
; 1273 RCNT = .BLK[STB_CNT];
; 1274 IF .RCNT GTR 0 THEN
; 1275 WHILE (RCNT=.RCNT-1) GEQ 0 DO
; 1276 BEGIN
; 1277 CHR = CH$RCHAR_A(PTRI);
; 1278 IF .CHR EQL $CHCRT
; 1279 THEN
; 1280 BEGIN
; 1281 LOCAL
; 1282 NBLK : REF STB_BLK, ! New string block
; 1283 LEN;
; 1284 IF (CHR = CH$RCHAR(.PTRI)) EQL $CHLFD
; 1285 THEN
; 1286 BEGIN
; 1287 CHR = CH$RCHAR_A(PTRI);
; 1288 CHR = CH$RCHAR(.PTRI);
; 1289 RCNT = .RCNT - 1
; 1290 END;
; 1291 IF .RCNT LSS 0 THEN EXITLOOP;
; 1292 LEN = (.RCNT + 9)/5;
; 1293 NBLK = PCMGMM(.LEN, XDICT);
; 1294 NBLK[STB_CNT] = .RCNT;
; 1295 NBLK[STB_LEN] = .LEN;
; 1296 PCCURC[ECB_DCB] = .NBLK;
; 1297 CH$MOVE(.RCNT, .PTRI, BYTPTR(NBLK[STB_BUF]));
; 1298 EXITLOOP
; 1299 END
; 1300 ELSE
; 1301 BEGIN
; 1302 CH$WCHAR_A(.CHR,PTRO);
; 1303 ICNT = .ICNT + 1
; 1304 END
; 1305 END;
; 1306 RETMEM( .BLK[STB_LEN], .BLK, XDICT);
; 1307 CH$WCHAR_A($CHCRT,PTRO);
; 1308 CH$WCHAR_A($CHLFD,PTRO);
; 1309 .ICNT + 2
; 1310 END;
PUTDCL: 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
MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC10,6(AC1) ; BLK,6(AC1)
HLLZS 6(AC1) ; 6(AC1)
SETZM -1(SP) ; ICNT
MOVE AC2,AC10 ; HLF,BLK
ADDI AC2,1 ; HLF,1
HRLI AC2,-337100 ; HLF,-337100
MOVE AC11,AC2 ; PTRI,HLF
MOVE AC1,CMPTR ; AC1,CMPTR
MOVEM AC1,0(SP) ; AC1,PTRO
HLRZ AC14,0(AC10) ; RCNT,0(BLK)
JUMPLE AC14,L.109 ; RCNT,L.109
L.106: SOJL AC14,L.109 ; RCNT,L.109
ILDB AC12,AC11 ; CHR,PTRI
CAIE AC12,15 ; CHR,15
JRST L.108 ; L.108
MOVE AC2,AC11 ; AC2,PTRI
ILDB AC12,AC2 ; CHR,AC2
CAIE AC12,12 ; CHR,12
JRST L.107 ; L.107
ILDB AC12,AC11 ; CHR,PTRI
MOVE AC2,AC11 ; AC2,PTRI
ILDB AC12,AC2 ; CHR,AC2
SUBI AC14,1 ; RCNT,1
L.107: JUMPL AC14,L.109 ; RCNT,L.109
MOVE AC1,AC14 ; AC1,RCNT
ADDI AC1,11 ; AC1,11
IDIVI AC1,5 ; AC1,5
MOVE AC13,AC1 ; LEN,AC1
MOVEI AC2,XDICT ; AC2,XDICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
HRLM AC14,0(AC1) ; RCNT,0(NBLK)
HRRM AC13,0(AC1) ; LEN,0(NBLK)
MOVE AC2,PCCURC ; AC2,PCCURC
HRRM AC1,6(AC2) ; NBLK,6(AC2)
MOVE AC3,AC1 ; HLF,NBLK
ADDI AC3,1 ; HLF,1
HRLI AC3,-337100 ; HLF,-337100
MOVE AC1,AC14 ; AC1,RCNT
MOVE AC2,AC11 ; AC2,PTRI
MOVE AC4,AC14 ; AC4,RCNT
MOVE AC5,AC3 ; AC5,HLF
EXTEND AC1,C.22 ; AC1,[MOVSLJ ]
JFCL ;
JRST L.109 ; L.109
L.108: IDPB AC12,0(SP) ; CHR,PTRO
AOS -1(SP) ; ICNT
JRST L.106 ; L.106
L.109: HRRZ AC1,0(AC10) ; AC1,0(BLK)
MOVE AC2,AC10 ; AC2,BLK
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
MOVEI AC1,15 ; AC1,15
IDPB AC1,0(SP) ; AC1,PTRO
MOVEI AC1,12 ; AC1,12
IDPB AC1,0(SP) ; AC1,PTRO
MOVE AC1,-1(SP) ; AC1,ICNT
ADDI AC1,2 ; AC1,2
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: 71 words
; 1311
; 1312 ROUTINE DOCARG(FFDB): NOVALUE = ! Get command arguments
; 1313
; 1314 !++
; 1315 ! Functional description:
; 1316 ! Perform simple-format command parameter parsing.
; 1317 ! Starting at first FLDDB, copy and execute each FLDDB,
; 1318 ! storing the results of each successful one and aborting
; 1319 ! to any error exit for each unsuccessful one. After
; 1320 ! the last FLDDB, require a .CMCFM.
; 1321 !
; 1322 ! Formal parameters:
; 1323 ! Constant index of first FLDDB, or -1 if only CONFIRM wanted
; 1324 !
; 1325 ! Implicit inputs:
; 1326 ! FLDDB list
; 1327 !
; 1328 ! Implicit outputs:
; 1329 ! User's variables
; 1330 !
; 1331 ! Routine value:
; 1332 ! None
; 1333 !
; 1334 ! Side effects:
; 1335 ! May change PC to enter error handler
; 1336 !
; 1337 !--
; 1338
; 1339 BEGIN
; 1340 EXTERNAL REGISTER Z;
; 1341 LOCAL
; 1342 PFDB: REF VECTOR, ! Proto-FLDDB pointer
; 1343 RFDB: REF VECTOR, ! Read-FLDDB pointer
; 1344 OPTFLG, ! Options
; 1345 HLFTMP: HLF_WRD;
; 1346 BIND
; 1347 TXT_FLDDB = UPLIT(%O'017000000000',0,0,0);
; 1348
; 1349 PFDB = .FFDB;
; 1350 IF .PFDB GEQ 0
; 1351 THEN
; 1352 DO
; 1353 BEGIN
; 1354 RFDB = COPFDB(.PFDB);
; 1355 PFDB = .PFDB + .CURCNS;
; 1356 POINTR((RFDB[$CMFNP]),CM_LST) = 0;
; 1357 OPTFLG = (IF .POINTR((RFDB[$CMFNP]),CM_NIN) EQL 0 THEN 2 ELSE 0);
; 1358 ! This stores results in system variables
; 1359 IF PCIPRS(.RFDB, .OPTFLG) LSS 0
; 1360 THEN
; 1361 BEGIN
; 1362 ! Take failure jump if provided, otherwise give standard error
; 1363 RELFDB(.RFDB);
; 1364 HLFTMP = .PFDB[$CMBRK];
; 1365 IF .HLFTMP[HLF_RGT] EQL %O'777777'
; 1366 THEN
; 1367 ! Give this some text if there is ever any demand
; 1368 PCMPER(0)
; 1369 ELSE
; 1370 BEGIN
; 1371 PC = .HLFTMP[HLF_RGT];
; 1372 PCIPRS(TXT_FLDDB, 0);
; 1373 RETURN
; 1374 END
; 1375 END;
; 1376 RELFDB(.RFDB);
; 1377 HLFTMP = .PFDB[$CMBRK];
; 1378 IF .HLFTMP[HLF_LFT] NEQ %O'777777'
; 1379 THEN
; 1380 CASE .POINTR((PFDB[$CMFNP]),CM_FNC) FROM $CMKEY TO $CMFLS OF
; 1381 SET
; 1382 [$CMKEY,
; 1383 $CMNUM,
; 1384 $CMSWI]: PCESOP(.HLFTMP[HLF_LFT], .PCVVAL, STE_TYP_INT);
; 1385 [$CMIFI,
; 1386 $CMOFI,
; 1387 $CMFIL,
; 1388 $CMFLS]: PCESOP(.HLFTMP[HLF_LFT], PCECST(DIVFNM()), STE_TYP_STR);
; 1389 [$CMFLD,
; 1390 $CMDIR,
; 1391 $CMUSR,
; 1392 $CMDEV,
; 1393 $CMTXT,
; 1394 $CMTAD,
; 1395 $CMQST,
; 1396 $CMNOD]: PCESOP(.HLFTMP[HLF_LFT], PCECST(.PCVATM), STE_TYP_STR);
; 1397 [INRANGE]: ;
; 1398 TES
; 1399 END
; 1400 UNTIL (PFDB = .POINTR((PFDB[$CMFNP]),CM_LST)) EQL 0;
; 1401 IF PCIPRS(CFM_FLDDB, 0) LSS 0 THEN PCMPER(0);
; 1402 PCCURC[ECB_PAR] = 0
; 1403 END;
P.ABC: EXP 17000000000
EXP 0
EXP 0
EXP 0
TXT_FLDDB= P.ABC
DOCARG: 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 AC14,AC1 ; PFDB,FFDB
JUMPL AC14,L.122 ; PFDB,L.122
L.110: MOVE AC1,AC14 ; AC1,PFDB
PUSHJ SP,COPFDB ; SP,COPFDB
MOVE AC11,AC1 ; RFDB,AC1
ADD AC14,CURCNS ; PFDB,CURCNS
HLLZS 0(AC11) ; 0(RFDB)
LDB AC1,C.38 ; AC1,[POINT 1,0(RFDB),9] <26,1>
JUMPN AC1,L.111 ; AC1,L.111
MOVEI AC10,2 ; OPTFLG,2
JRST L.112 ; L.112
L.111: SETZ AC10, ; OPTFLG,
L.112: MOVE AC1,AC11 ; AC1,RFDB
MOVE AC2,AC10 ; AC2,OPTFLG
PUSHJ SP,PCIPRS ; SP,PCIPRS
JUMPGE AC1,L.114 ; AC1,L.114
MOVE AC1,AC11 ; AC1,RFDB
PUSHJ SP,RELFDB ; SP,RELFDB
MOVE AC12,4(AC14) ; HLFTMP,4(PFDB)
MOVEI AC1,0(AC12) ; AC1,0(HLFTMP)
CAIE AC1,-1 ; AC1,-1
JRST L.113 ; L.113
SETZ AC1, ; AC1,
PUSHJ SP,PCMPER ; SP,PCMPER
JRST L.114 ; L.114
L.113: MOVEM AC1,PC ; AC1,PC
MOVEI AC1,TXT_FLDDB ; AC1,TXT_FLDDB
SETZ AC2, ; AC2,
PUSHJ SP,PCIPRS ; SP,PCIPRS
JRST L.124 ; L.124
L.114: MOVE AC1,AC11 ; AC1,RFDB
PUSHJ SP,RELFDB ; SP,RELFDB
MOVE AC12,4(AC14) ; HLFTMP,4(PFDB)
HLRZ AC13,AC12 ; AC13,HLFTMP
CAIN AC13,-1 ; AC13,-1
JRST L.121 ; L.121
LDB AC1,C.39 ; AC1,[POINT 9,0(PFDB),8] <27,9>
JRST L.115(AC1) ; L.115(AC1)
L.115: JRST L.116 ; L.116
JRST L.116 ; L.116
JRST L.121 ; L.121
JRST L.116 ; L.116
JRST L.117 ; L.117
JRST L.117 ; L.117
JRST L.117 ; L.117
JRST L.118 ; L.118
JRST L.121 ; L.121
JRST L.118 ; L.118
JRST L.118 ; L.118
JRST L.121 ; L.121
JRST L.121 ; L.121
JRST L.121 ; L.121
JRST L.118 ; L.118
JRST L.118 ; L.118
JRST L.118 ; L.118
JRST L.118 ; L.118
JRST L.121 ; L.121
JRST L.121 ; L.121
JRST L.121 ; L.121
JRST L.121 ; L.121
JRST L.118 ; L.118
JRST L.117 ; L.117
L.116: MOVE AC1,AC13 ; AC1,AC13
MOVE AC2,PCVVAL ; AC2,PCVVAL
SETZ AC3, ; AC3,
JRST L.120 ; L.120
L.117: PUSHJ SP,DIVFNM ; SP,DIVFNM
JRST L.119 ; L.119
L.118: MOVE AC1,PCVATM ; AC1,PCVATM
L.119: PUSHJ SP,PCECST ; SP,PCECST
MOVE AC2,AC1 ; AC2,AC1
MOVE AC1,AC13 ; AC1,AC13
MOVEI AC3,1 ; AC3,1
L.120: PUSHJ SP,PCESOP ; SP,PCESOP
L.121: HRRZ AC14,0(AC14) ; PFDB,0(PFDB)
JUMPN AC14,L.110 ; PFDB,L.110
L.122: MOVEI AC1,CFM_FLDDB ; AC1,CFM_FLDDB
SETZ AC2, ; AC2,
PUSHJ SP,PCIPRS ; SP,PCIPRS
JUMPGE AC1,L.123 ; AC1,L.123
SETZ AC1, ; AC1,
PUSHJ SP,PCMPER ; SP,PCMPER
L.123: MOVE AC1,PCCURC ; AC1,PCCURC
MOVSI AC2,10000 ; AC2,10000
ANDCAM AC2,12(AC1) ; AC2,12(AC1)
L.124: 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.38: POINT 1,0(AC11),9 ; 1,0(RFDB),9
C.39: POINT 9,0(AC14),8 ; 9,0(PFDB),8
; Routine Size: 98 words
; 1404
; 1405 ROUTINE DPARSE: NOVALUE = ! Parse instruction
; 1406
; 1407 !++
; 1408 ! Functional description:
; 1409 ! Execute PRS instruction. Field A contains location of
; 1410 ! first field descriptor block in the chain; it is position
; 1411 ! independent so I must allocate temporary space for each
; 1412 ! block and rebuild everything. Then I pass the copied list
; 1413 ! to the Interface to do a COMND%. The Interface will return
; 1414 ! the address of the successful FLDDB, so I can jump
; 1415 ! accordingly. If nothing succeeded, I jump to operand C,
; 1416 ! or issue a standard error message if C is -1.
; 1417 ! If a reparse happened, I jump back to the user's last
; 1418 ! Prompt instruction.
; 1419 ! After releasing the temporary space, I am done.
; 1420 !
; 1421 ! Formal parameters:
; 1422 ! None
; 1423 !
; 1424 ! Implicit inputs:
; 1425 ! Instruction stream, field descriptor blocks
; 1426 !
; 1427 ! Implicit outputs:
; 1428 ! None
; 1429 !
; 1430 ! Routine value:
; 1431 ! None
; 1432 !
; 1433 ! Side effects:
; 1434 ! Causes a Jump to the selected processing
; 1435 ! routine, and causes appropriate system variables to be set.
; 1436 !
; 1437 !--
; 1438
; 1439 BEGIN
; 1440 EXTERNAL REGISTER Z;
; 1441 LOCAL
; 1442 IFDB, ! Proto-FLDDB pointer
; 1443 OFDB, ! Real-FLDDB pointer
; 1444 TFDB, ! First real FLDDB
; 1445 SUCC, ! Success address
; 1446 OPTFLG; ! Options for the parse
; 1447
; 1448 IF .PCCURC[ECB_PAR] EQL 0 THEN ERROR('No command parse in progress');
; 1449 IFDB = .INSTR[COD_OPA];
; 1450 OFDB = COPFDB(.IFDB);
; 1451 TFDB = .OFDB;
; 1452 OPTFLG = (IF .POINTR((.OFDB+$CMFNP),CM_NIN) EQL 0 THEN 2 ELSE 0);
; 1453 IF .PCCURC[ECB_SCM] THEN OPTFLG = .OPTFLG + 1;
; 1454 WHILE .POINTR((CURCNS[.IFDB+$CMFNP]),CM_LST) NEQ 0 DO
; 1455 BEGIN
; 1456 IFDB = .POINTR((CURCNS[.IFDB+$CMFNP]),CM_LST);
; 1457 POINTR((.OFDB+$CMFNP),CM_LST) = COPFDB(.IFDB);
; 1458 OFDB = .POINTR((.OFDB+$CMFNP),CM_LST)
; 1459 END;
; 1460 POINTR((.OFDB+$CMFNP),CM_LST) = 0;
; 1461 SUCC = PCIPRS(.TFDB, .OPTFLG);
; 1462 IFDB = .TFDB;
; 1463 IF .SUCC GTR 0
; 1464 THEN
; 1465 BEGIN
; 1466 PC = .(.SUCC+$CMBRK);
; 1467 IF .POINTR((.SUCC+$CMFNP),CM_FNC) EQL $CMCFM THEN PCCURC[ECB_PAR] = 0
; 1468 END;
; 1469 WHILE .IFDB NEQ 0 DO
; 1470 BEGIN
; 1471 OFDB = .IFDB;
; 1472 IFDB = .POINTR((.IFDB+$CMFNP),CM_LST);
; 1473 RELFDB(.OFDB)
; 1474 END;
; 1475 IF .SUCC LEQ 0
; 1476 THEN
; 1477 IF .SUCC EQL -2
; 1478 THEN
; 1479 PC = .LSTPMT
; 1480 ELSE
; 1481 IF .INSTR[COD_OPC] EQL %O'777777'
; 1482 THEN
; 1483 PCMPER(0)
; 1484 ELSE
; 1485 PC = .INSTR[COD_OPC]
; 1486 END;
P.ABD: BYTE (7)"N","o"," ","c","o" ; No co
BYTE (7)"m","m","a","n","d" ; mmand
BYTE (7)" ","p","a","r","s" ; pars
BYTE (7)"e"," ","i","n"," " ; e in
BYTE (7)"p","r","o","g","r" ; progr
BYTE (7)"e","s","s",000,000 ; ess
DPARSE: PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC1,PCCURC ; AC1,PCCURC
LDB AC2,C.37 ; AC2,[POINT 1,12(AC1),5] <30,1>
JUMPN AC2,L.125 ; AC2,L.125
MOVEI AC1,P.ABD ; AC1,P.ABD
PUSHJ SP,PCEERR ; SP,PCEERR
L.125: HRRZ AC13,INSTR ; IFDB,INSTR
MOVE AC1,AC13 ; AC1,IFDB
PUSHJ SP,COPFDB ; SP,COPFDB
MOVE AC12,AC1 ; OFDB,AC1
MOVE AC11,AC12 ; TFDB,OFDB
LDB AC1,C.40 ; AC1,[POINT 1,0(OFDB),9] <26,1>
JUMPN AC1,L.126 ; AC1,L.126
MOVEI AC14,2 ; OPTFLG,2
JRST L.127 ; L.127
L.126: SETZ AC14, ; OPTFLG,
L.127: MOVE AC1,PCCURC ; AC1,PCCURC
MOVSI AC2,100000 ; AC2,100000
TDNE AC2,12(AC1) ; AC2,12(AC1)
ADDI AC14,1 ; OPTFLG,1
L.128: MOVE AC1,CURCNS ; AC1,CURCNS
ADD AC1,AC13 ; AC1,IFDB
HRRZ AC1,0(AC1) ; AC1,0(AC1)
JUMPE AC1,L.129 ; AC1,L.129
MOVE AC13,AC1 ; IFDB,AC1
PUSHJ SP,COPFDB ; SP,COPFDB
HRRM AC1,0(AC12) ; AC1,0(OFDB)
HRRZ AC12,0(AC12) ; OFDB,0(OFDB)
JRST L.128 ; L.128
L.129: HLLZS 0(AC12) ; 0(OFDB)
MOVE AC1,AC11 ; AC1,TFDB
MOVE AC2,AC14 ; AC2,OPTFLG
PUSHJ SP,PCIPRS ; SP,PCIPRS
MOVE AC14,AC1 ; SUCC,AC1
MOVE AC13,AC11 ; IFDB,TFDB
JUMPLE AC14,L.130 ; SUCC,L.130
MOVE AC1,4(AC14) ; AC1,4(SUCC)
MOVEM AC1,PC ; AC1,PC
LDB AC1,C.39 ; AC1,[POINT 9,0(AC14),8] <27,9>
CAIE AC1,10 ; AC1,10
JRST L.130 ; L.130
MOVE AC1,PCCURC ; AC1,PCCURC
MOVSI AC2,10000 ; AC2,10000
ANDCAM AC2,12(AC1) ; AC2,12(AC1)
L.130: JUMPE AC13,L.131 ; IFDB,L.131
MOVE AC12,AC13 ; OFDB,IFDB
HRRZ AC13,0(AC13) ; IFDB,0(IFDB)
MOVE AC1,AC12 ; AC1,OFDB
PUSHJ SP,RELFDB ; SP,RELFDB
JRST L.130 ; L.130
L.131: JUMPG AC14,L.134 ; SUCC,L.134
CAME AC14,C.41 ; SUCC,[-2]
JRST L.132 ; L.132
MOVE AC1,LSTPMT ; AC1,LSTPMT
JRST L.133 ; L.133
L.132: HRRZ AC1,INSTR+1 ; AC1,INSTR+1
CAIE AC1,-1 ; AC1,-1
JRST L.133 ; L.133
SETZ AC1, ; AC1,
PUSHJ SP,PCMPER ; SP,PCMPER
JRST L.134 ; L.134
L.133: MOVEM AC1,PC ; AC1,PC
L.134: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POPJ SP, ; SP,
C.40: POINT 1,0(AC12),9 ; 1,0(OFDB),9
C.41: EXP -2 ; -2
; Routine Size: 72 words
; 1487
; 1488 ROUTINE COPFDB(IFDB) = ! Make real FLDDB from prototype
; 1489
; 1490 !++
; 1491 ! Functional description:
; 1492 ! Given a proto-FLDDB, get a temporary block and make a real
; 1493 ! FLDDB in it from the proto-FLDDB. If the field type requires
; 1494 ! only the basic five words, fine; if not, copy and relocate all
; 1495 ! the additional information (help string, keyword table, etc.).
; 1496 ! Returns the real address of this real FLDDB, which must be
; 1497 ! completely ready for a COMND%.
; 1498 ! This routine is necessary because routines are stored in
; 1499 ! position-independent format. This position independence
; 1500 ! applies to the pointers in FLDDB's, so all pointers to
; 1501 ! strings and TBLUK% tables must be relocated.
; 1502 !
; 1503 ! Formal parameters:
; 1504 ! Index into constants of prototype FLDDB
; 1505 !
; 1506 ! Implicit inputs:
; 1507 ! None
; 1508 !
; 1509 ! Implicit outputs:
; 1510 ! None
; 1511 !
; 1512 ! Routine value:
; 1513 ! Real address of real FLDDB
; 1514 !
; 1515 ! Side effects:
; 1516 ! None
; 1517 !
; 1518 !--
; 1519
; 1520 BEGIN
; 1521 EXTERNAL REGISTER Z;
; 1522 LOCAL
; 1523 OPV: STR_VAL, ! String temporary
; 1524 PFDB: REF VECTOR, ! Prototype FLDDB
; 1525 RFDB: REF VECTOR; ! Real FLDDB
; 1526 PFDB = .IFDB + .CURCNS;
; 1527 RFDB = GETBUF(5);
; 1528 RFDB[$CMFNP] = .PFDB[$CMFNP];
; 1529 RFDB[$CMBRK] = .PFDB[$CMBRK];
; 1530 CASE .POINTR((RFDB[$CMFNP]),CM_FNC) FROM $CMKEY TO $CMFLS OF
; 1531 SET
; 1532 [$CMKEY]: RFDB[$CMDAT] = COPKWT(.PFDB);
; 1533 [$CMNUM]: RFDB[$CMDAT] = .PFDB[$CMDAT];
; 1534 [$CMNOI]: BEGIN
; 1535 OPV = PCEGOP(.PFDB[$CMDAT],STE_TYP_STR);
; 1536 RFDB[$CMDAT] = BYTPTR(.OPV[STV_ADR])
; 1537 END;
; 1538 [$CMSWI]: RFDB[$CMDAT] = COPKWT(.PFDB);
; 1539 [$CMFIL,
; 1540 $CMFLS]: COPFDF(.PFDB[$CMDAT]);
; 1541 [$CMTAD]: RFDB[$CMDAT] = .PFDB[$CMDAT];
; 1542 [$CMTOK]: BEGIN
; 1543 OPV = PCEGOP(.PFDB[$CMDAT],STE_TYP_STR);
; 1544 RFDB[$CMDAT] = BYTPTR(.OPV[STV_ADR])
; 1545 END;
; 1546 [INRANGE]: ;
; 1547 TES;
; 1548 IF .POINTR((RFDB[$CMFNP]),CM_HPP)
; 1549 THEN
; 1550 BEGIN
; 1551 OPV = PCEGOP(.PFDB[$CMHLP],STE_TYP_STR);
; 1552 RFDB[$CMHLP] = BYTPTR(.OPV[STV_ADR])
; 1553 END;
; 1554 IF .POINTR((RFDB[$CMFNP]),CM_DPP)
; 1555 THEN
; 1556 BEGIN
; 1557 OPV = PCEGOP(.PFDB[$CMDEF],STE_TYP_STR);
; 1558 RFDB[$CMDEF] = BYTPTR(.OPV[STV_ADR])
; 1559 END;
; 1560 .RFDB
; 1561 END;
COPFDB: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC1 ; PFDB,IFDB
ADD AC14,CURCNS ; PFDB,CURCNS
MOVEI AC1,5 ; AC1,5
PUSHJ SP,GETBUF ; SP,GETBUF
MOVE AC13,AC1 ; RFDB,AC1
MOVE AC1,0(AC14) ; AC1,0(PFDB)
MOVEM AC1,0(AC13) ; AC1,0(RFDB)
MOVE AC1,4(AC14) ; AC1,4(PFDB)
MOVEM AC1,4(AC13) ; AC1,4(RFDB)
LDB AC1,C.42 ; AC1,[POINT 9,0(RFDB),8] <27,9>
JRST L.135(AC1) ; L.135(AC1)
L.135: JRST L.136 ; L.136
JRST L.138 ; L.138
JRST L.139 ; L.139
JRST L.136 ; L.136
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.137 ; L.137
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.138 ; L.138
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.139 ; L.139
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.141 ; L.141
JRST L.137 ; L.137
L.136: MOVE AC1,AC14 ; AC1,PFDB
PUSHJ SP,COPKWT ; SP,COPKWT
JRST L.140 ; L.140
L.137: MOVE AC1,1(AC14) ; AC1,1(PFDB)
PUSHJ SP,COPFDF ; SP,COPFDF
JRST L.141 ; L.141
L.138: MOVE AC1,1(AC14) ; AC1,1(PFDB)
JRST L.140 ; L.140
L.139: MOVE AC1,1(AC14) ; AC1,1(PFDB)
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC3,AC1 ; OPV,AC1
MOVEI AC1,0(AC3) ; HLF,0(OPV)
HRLI AC1,-337100 ; HLF,-337100
L.140: MOVEM AC1,1(AC13) ; HLF,1(RFDB)
L.141: MOVSI AC1,4 ; AC1,4
TDNN AC1,0(AC13) ; AC1,0(RFDB)
JRST L.142 ; L.142
MOVE AC1,2(AC14) ; AC1,2(PFDB)
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC3,AC1 ; OPV,AC1
MOVEI AC1,0(AC3) ; HLF,0(OPV)
HRLI AC1,-337100 ; HLF,-337100
MOVEM AC1,2(AC13) ; HLF,2(RFDB)
L.142: MOVSI AC1,2 ; AC1,2
TDNN AC1,0(AC13) ; AC1,0(RFDB)
JRST L.143 ; L.143
MOVE AC1,3(AC14) ; AC1,3(PFDB)
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC3,AC1 ; OPV,AC1
MOVEI AC1,0(AC3) ; HLF,0(OPV)
HRLI AC1,-337100 ; HLF,-337100
MOVEM AC1,3(AC13) ; HLF,3(RFDB)
L.143: MOVE AC1,AC13 ; AC1,RFDB
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.42: POINT 9,0(AC13),8 ; 9,0(RFDB),8
; Routine Size: 77 words
; 1562
; 1563 ROUTINE COPKWT(PFDB) = ! Copy keyword table
; 1564
; 1565 !++
; 1566 ! Functional description:
; 1567 ! Copies keyword table for Parse.
; 1568 !
; 1569 ! Formal parameters:
; 1570 ! Address of prototype FLDDB
; 1571 !
; 1572 ! Implicit inputs:
; 1573 ! None
; 1574 !
; 1575 ! Implicit outputs:
; 1576 ! None
; 1577 !
; 1578 ! Routine value:
; 1579 ! Real address of real keyword table
; 1580 !
; 1581 ! Side effects:
; 1582 ! None
; 1583 !
; 1584 !--
; 1585
; 1586 BEGIN
; 1587 EXTERNAL REGISTER Z;
; 1588 MAP
; 1589 PFDB: REF VECTOR; ! Prototype FLDDB
; 1590 LOCAL
; 1591 CNT: HLF_WRD, ! Keyword count
; 1592 HLFTMP: HLF_WRD, ! Temporary
; 1593 RTBL: REF VECTOR, ! Pointer to real keyword table
; 1594 PTBL: REF VECTOR; ! Pointer to prototype keyword table
; 1595 PTBL = .PFDB[$CMDAT] + .CURCNS;
; 1596 CNT = .PTBL[0];
; 1597 CNT = .CNT[HLF_RGT];
; 1598 RTBL = GETBUF(.CNT+1);
; 1599 RTBL[0] = .PTBL[0];
; 1600 PTBL = .PTBL+1;
; 1601 DECR I FROM .CNT-1 DO
; 1602 BEGIN
; 1603 HLFTMP = .PTBL[.I];
; 1604 HLFTMP[HLF_LFT] = .HLFTMP[HLF_LFT] + .CURCNS;
; 1605 RTBL[.I+1] = .HLFTMP
; 1606 END;
; 1607 .RTBL
; 1608 END;
COPKWT: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC13,1(AC1) ; PTBL,1(PFDB)
ADD AC13,CURCNS ; PTBL,CURCNS
MOVE AC14,0(AC13) ; CNT,0(PTBL)
MOVEI AC14,0(AC14) ; CNT,0(CNT)
MOVE AC1,AC14 ; AC1,CNT
ADDI AC1,1 ; AC1,1
PUSHJ SP,GETBUF ; SP,GETBUF
MOVE AC4,AC1 ; RTBL,AC1
MOVE AC1,0(AC13) ; AC1,0(PTBL)
MOVEM AC1,0(AC4) ; AC1,0(RTBL)
ADDI AC13,1 ; PTBL,1
MOVE AC2,AC14 ; I,CNT
JRST L.145 ; L.145
L.144: MOVE AC1,AC13 ; AC1,PTBL
ADD AC1,AC2 ; AC1,I
MOVE AC3,0(AC1) ; HLFTMP,0(AC1)
HLRZ AC1,AC3 ; AC1,HLFTMP
ADD AC1,CURCNS ; AC1,CURCNS
HRL AC3,AC1 ; HLFTMP,AC1
MOVE AC1,AC4 ; AC1,RTBL
ADD AC1,AC2 ; AC1,I
MOVEM AC3,1(AC1) ; HLFTMP,1(AC1)
L.145: SOJGE AC2,L.144 ; I,L.144
MOVE AC1,AC4 ; AC1,RTBL
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 29 words
; 1609
; 1610 ROUTINE COPFDF(DAT): NOVALUE = ! Copy FILE defaults
; 1611
; 1612 !++
; 1613 ! Functional description:
; 1614 ! Set up the GTJFN block for a .CMFIL or .CMFLS parse. If the user
; 1615 ! supplies a list of defaults, fill in the appropriate fields; otherwise
; 1616 ! clear the GTJFN block.
; 1617 !
; 1618 ! Formal parameters:
; 1619 ! Constant index of default list from prototype
; 1620 !
; 1621 ! Implicit inputs:
; 1622 ! None
; 1623 !
; 1624 ! Implicit outputs:
; 1625 ! GTJFN block
; 1626 !
; 1627 ! Routine value:
; 1628 ! None
; 1629 !
; 1630 ! Side effects:
; 1631 ! None
; 1632 !
; 1633 !--
; 1634
; 1635 BEGIN
; 1636 EXTERNAL REGISTER Z;
; 1637 LOCAL
; 1638 STR: STR_VAL; ! User's string
; 1639
; 1640 DECR I FROM $GJACT-1 DO CJFNBK[.I] = 0;
; 1641 CJFNBK[$GJF2] = 0;
; 1642 IF .DAT EQL 0 THEN RETURN;
; 1643 CJFNBK[$GJGEN] = .CURCNS[.DAT];
; 1644 CJFNBK[$GJF2] = .CURCNS[.DAT+1];
; 1645 DECR I FROM $GJEXT TO $GJDEV DO
; 1646 IF .CURCNS[.DAT+.I] NEQ -1
; 1647 THEN
; 1648 BEGIN
; 1649 STR = PCEGOP(.CURCNS[.DAT+.I],STE_TYP_STR);
; 1650 CJFNBK[.I] = BYTPTR(.STR[STV_ADR])
; 1651 END
; 1652 END;
COPFDF: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC13,AC1 ; DAT,AC1
MOVEI AC1,6 ; I,6
L.146: SETZM CJFNBK(AC1) ; CJFNBK(I)
SOJGE AC1,L.146 ; I,L.146
SETZM CJFNBK+11 ; CJFNBK+11
JUMPE AC13,L.149 ; DAT,L.149
MOVE AC1,CURCNS ; AC1,CURCNS
MOVE AC2,AC1 ; AC2,AC1
ADD AC2,AC13 ; AC2,DAT
MOVE AC3,0(AC2) ; AC3,0(AC2)
MOVEM AC3,CJFNBK ; AC3,CJFNBK
ADD AC1,AC13 ; AC1,DAT
MOVE AC2,1(AC1) ; AC2,1(AC1)
MOVEM AC2,CJFNBK+11 ; AC2,CJFNBK+11
MOVEI AC14,5 ; I,5
L.147: MOVE AC3,CURCNS ; AC3,CURCNS
MOVE AC1,AC13 ; AC1,DAT
ADD AC1,AC14 ; AC1,I
ADD AC3,AC1 ; AC3,AC1
SETO AC1, ; AC1,
CAMN AC1,0(AC3) ; AC1,0(AC3)
JRST L.148 ; L.148
MOVE AC1,0(AC3) ; AC1,0(AC3)
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC4,AC1 ; STR,AC1
MOVEI AC1,0(AC4) ; HLF,0(STR)
HRLI AC1,-337100 ; HLF,-337100
MOVEM AC1,CJFNBK(AC14) ; HLF,CJFNBK(I)
L.148: SUBI AC14,1 ; I,1
CAIL AC14,2 ; I,2
JRST L.147 ; L.147
L.149: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 37 words
; 1653
; 1654 ROUTINE RELFDB(OFDB): NOVALUE = ! Free storage for real FLDDB
; 1655
; 1656 !++
; 1657 ! Functional description:
; 1658 ! Frees temporary block used for real FLDDB, including copies
; 1659 ! of Help and Default strings, and keyword table
; 1660 !
; 1661 ! Formal parameters:
; 1662 ! Real address of FLDDB
; 1663 !
; 1664 ! Implicit inputs:
; 1665 ! None
; 1666 !
; 1667 ! Implicit outputs:
; 1668 ! None
; 1669 !
; 1670 ! Routine value:
; 1671 ! None
; 1672 !
; 1673 ! Side effects:
; 1674 ! None
; 1675 !
; 1676 !--
; 1677
; 1678 BEGIN
; 1679 EXTERNAL REGISTER Z;
; 1680 MAP
; 1681 OFDB: REF VECTOR;
; 1682 IF (.POINTR((OFDB[$CMFNP]),CM_FNC) EQL $CMKEY) OR
; 1683 (.POINTR((OFDB[$CMFNP]),CM_FNC) EQL $CMSWI)
; 1684 THEN
; 1685 BEGIN
; 1686 LOCAL
; 1687 PTR,
; 1688 CNT: HLF_WRD;
; 1689 PTR = .OFDB[$CMDAT];
; 1690 CNT = ..PTR;
; 1691 RETMEM( .CNT[HLF_RGT]+1, .PTR, DICT)
; 1692 END;
; 1693 RETMEM(4,.OFDB,DICT);
; 1694 END;
RELFDB: PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC1 ; OFDB,AC1
LDB AC1,C.39 ; AC1,[POINT 9,0(AC14),8] <27,9>
JUMPE AC1,L.150 ; AC1,L.150
CAIE AC1,3 ; AC1,3
JRST L.151 ; L.151
L.150: MOVE AC2,1(AC14) ; PTR,1(OFDB)
MOVE AC1,0(AC2) ; CNT,0(PTR)
MOVEI AC1,0(AC1) ; AC1,0(CNT)
ADDI AC1,1 ; AC1,1
MOVEI AC3,DICT ; AC3,DICT
PUSHJ SP,RETMEM ; SP,RETMEM
L.151: MOVEI AC1,4 ; AC1,4
MOVE AC2,AC14 ; AC2,OFDB
MOVEI AC3,DICT ; AC3,DICT
PUSHJ SP,RETMEM ; SP,RETMEM
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 18 words
; 1695
; 1696 ROUTINE DPRMPT: NOVALUE = ! Prompt instruction
; 1697
; 1698 !++
; 1699 ! Functional description:
; 1700 ! Execute PMT/PMN instruction. Begin new command-parse line
; 1701 ! with the prompt given in string A.
; 1702 !
; 1703 ! Formal parameters:
; 1704 ! None
; 1705 !
; 1706 ! Implicit inputs:
; 1707 ! Instruction stream
; 1708 !
; 1709 ! Implicit outputs:
; 1710 ! None
; 1711 !
; 1712 ! Routine value:
; 1713 ! None
; 1714 !
; 1715 ! Side effects:
; 1716 ! None
; 1717 !
; 1718 !--
; 1719
; 1720 BEGIN
; 1721 EXTERNAL REGISTER Z;
; 1722 LOCAL STR: STR_VAL;
; 1723 LSTPMT = .PC;
; 1724 PCCURC[ECB_SCM] = 1;
; 1725 PCCURC[ECB_PAR] = 1;
; 1726 PCCURC[ECB_ECO] = (IF .INSTR[COD_OPR] EQL OPR_PMT THEN 0 ELSE 1);
; 1727 STR = PCEGOP(.INSTR[COD_OPA],STE_TYP_STR);
; 1728 PCIPRS(0,.PCCURC[ECB_ECO],BYTPTR(.STR[STV_ADR]));
; 1729 END;
DPRMPT: MOVE AC1,PC ; AC1,PC
MOVEM AC1,LSTPMT ; AC1,LSTPMT
MOVE AC1,PCCURC ; AC1,PCCURC
MOVSI AC2,100000 ; AC2,100000
IORM AC2,12(AC1) ; AC2,12(AC1)
MOVSI AC2,10000 ; AC2,10000
IORM AC2,12(AC1) ; AC2,12(AC1)
LDB AC2,C.43 ; AC2,[POINT 6,INSTR,17] <18,6>
CAIN AC2,47 ; AC2,47
TDZA AC2,AC2 ; AC2,AC2
MOVEI AC2,1 ; AC2,1
DPB AC2,C.44 ; AC2,[POINT 1,12(AC1),3] <32,1>
HRRZ AC1,INSTR ; AC1,INSTR
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC4,PCCURC ; AC4,PCCURC
MOVEI AC3,0(AC1) ; HLF,0(STR)
HRLI AC3,-337100 ; HLF,-337100
SETZ AC1, ; AC1,
LDB AC2,C.45 ; AC2,[POINT 1,12(AC4),3] <32,1>
JRST PCIPRS ; PCIPRS
C.43: POINT 6,INSTR,17 ; 6,INSTR,17
C.44: POINT 1,12(AC1),3 ; 1,12(AC1),3
C.45: POINT 1,12(AC4),3 ; 1,12(AC4),3
; Routine Size: 24 words
; 1730
; 1731 ROUTINE GETEOP: NOVALUE = ! Get Exec output
; 1732
; 1733 !++
; 1734 ! Functional description:
; 1735 ! Get accumulated Exec typeout saved through PCL's PTY,
; 1736 ! and store it in the user variable designated in the last
; 1737 ! DoCommand instruction.
; 1738 !
; 1739 ! Formal parameters:
; 1740 ! None
; 1741 !
; 1742 ! Implicit inputs:
; 1743 ! Designator saved in ECB, PCPEOP
; 1744 !
; 1745 ! Implicit outputs:
; 1746 ! None
; 1747 !
; 1748 ! Routine value:
; 1749 ! None
; 1750 !
; 1751 ! Side effects:
; 1752 ! None
; 1753 !
; 1754 !--
; 1755
; 1756 BEGIN
; 1757 EXTERNAL REGISTER Z;
; 1758 LOCAL
; 1759 PTR: REF STB_BLK, ! String block
; 1760 DESIG, ! Designator of result
; 1761 OPV: STR_VAL; ! Stringvalue being created
; 1762 PCIPSO();
; 1763 ! Perhaps this should use EXCH
; 1764 PTR = .PCPEOP;
; 1765 PCPEOP = 0;
; 1766 DESIG = .PCCURC[ECB_DTO];
; 1767 PCCURC[ECB_DTO] = %O'777777';
; 1768 IF .PTR EQL 0
; 1769 THEN
; 1770 OPV = 0
; 1771 ELSE
; 1772 IF .PTR LSS 0
; 1773 THEN
; 1774 ERROR('Exec ran out of space storing typeout')
; 1775 ELSE
; 1776 BEGIN
; 1777 OPV = PCEAST(.PTR[STB_CNT]);
; 1778 IF .OPV NEQ 0
; 1779 THEN
; 1780 CH$COPY(.PTR[STB_CNT], BYTPTR(PTR[STB_BUF]),
; 1781 0, .OPV[STV_LEN]+1, BYTPTR(.OPV[STV_ADR]));
; 1782 RETMEM(.PTR[STB_LEN], .PTR, XDICT)
; 1783 END;
; 1784 PCESOP(.DESIG, .OPV, STE_TYP_STR)
; 1785 END;
P.ABE: BYTE (7)"E","x","e","c"," " ; Exec
BYTE (7)"r","a","n"," ","o" ; ran o
BYTE (7)"u","t"," ","o","f" ; ut of
BYTE (7)" ","s","p","a","c" ; spac
BYTE (7)"e"," ","s","t","o" ; e sto
BYTE (7)"r","i","n","g"," " ; ring
BYTE (7)"t","y","p","e","o" ; typeo
BYTE (7)"u","t",000,000,000 ; ut
GETEOP: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
PUSHJ SP,PCIPSO ; SP,PCIPSO
MOVE AC14,PCPEOP ; PTR,PCPEOP
SETZM PCPEOP ; PCPEOP
MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC12,6(AC1) ; DESIG,6(AC1)
HRROS 6(AC1) ; 6(AC1)
JUMPN AC14,L.152 ; PTR,L.152
SETZ AC13, ; OPV,
JRST L.155 ; L.155
L.152: JUMPGE AC14,L.153 ; PTR,L.153
MOVEI AC1,P.ABE ; AC1,P.ABE
PUSHJ SP,PCEERR ; SP,PCEERR
JRST L.155 ; L.155
L.153: HLRZ AC1,0(AC14) ; AC1,0(PTR)
PUSHJ SP,PCEAST ; SP,PCEAST
MOVE AC13,AC1 ; OPV,AC1
JUMPE AC13,L.154 ; OPV,L.154
MOVE AC2,AC14 ; HLF,PTR
ADDI AC2,1 ; HLF,1
HRLI AC2,-337100 ; HLF,-337100
HLRZ AC4,AC13 ; AC4,OPV
ADDI AC4,1 ; AC4,1
MOVEI AC5,0(AC13) ; HLF,0(OPV)
HRLI AC5,-337100 ; HLF,-337100
HLRZ AC1,0(AC14) ; AC1,0(PTR)
EXTEND AC1,C.3 ; AC1,C.3
JFCL ;
L.154: HRRZ AC1,0(AC14) ; AC1,0(PTR)
MOVE AC2,AC14 ; AC2,PTR
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
L.155: MOVE AC1,AC12 ; AC1,DESIG
MOVE AC2,AC13 ; AC2,OPV
MOVEI AC3,1 ; AC3,1
PUSHJ SP,PCESOP ; SP,PCESOP
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 42 words
; 1786
; 1787 ROUTINE DOTINP(FLG): NOVALUE = ! Typein instruction
; 1788
; 1789 !++
; 1790 ! Functional description:
; 1791 ! Executes TIN or TIX instruction: Takes string operand A and copies
; 1792 ! the string into the PTY controlling the user program. PCL
; 1793 ! execution waits until the program requires input.
; 1794 !
; 1795 ! Formal parameters:
; 1796 ! Flag: 0=TIN, 1=TIX
; 1797 !
; 1798 ! Implicit inputs:
; 1799 ! Instruction, operand
; 1800 !
; 1801 ! Implicit outputs:
; 1802 ! None
; 1803 !
; 1804 ! Routine value:
; 1805 ! None
; 1806 !
; 1807 ! Side effects:
; 1808 ! Waits for controlled program to need attention
; 1809 !
; 1810 !--
; 1811
; 1812 BEGIN
; 1813 EXTERNAL REGISTER Z;
; 1814 LOCAL
; 1815 OPND: STR_VAL, ! Operand descriptor
; 1816 SV: STR_VAL, ! Another string
; 1817 PTRI, ! String pointers
; 1818 PTRO,
; 1819 CHR,
; 1820 CNT;
; 1821 OPND = PCEGOP(.INSTR[COD_OPA],STE_TYP_STR);
; 1822 SV = PCEAST(.OPND[STV_LEN]+(IF .FLG EQL 0 THEN 1 ELSE 0));
; 1823 PTRI = BYTPTR(.OPND[STV_ADR]);
; 1824 PTRO = BYTPTR(.SV[STV_ADR]);
; 1825 CNT = .SV[STV_LEN];
; 1826 DECR I FROM .OPND[STV_LEN]-1 DO
; 1827 IF (CHR = CH$RCHAR_A(PTRI)) NEQ $CHLFD
; 1828 THEN
; 1829 CH$WCHAR_A(.CHR,PTRO)
; 1830 ELSE
; 1831 CNT = .CNT - 1;
; 1832 IF .FLG EQL 0 THEN CH$WCHAR_A($CHCRT,PTRO);
; 1833 CH$WCHAR_A($CHNUL,PTRO);
; 1834 IF .INSTR[COD_OPA] EQL OPN_TMP_STR THEN PCEFST(.OPND);
; 1835 PCITIN(BYTPTR(.SV[STV_ADR]), .CNT);
; 1836 PCEFST(.SV)
; 1837 END;
DOTINP: PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC1 ; FLG,AC1
HRRZ AC1,INSTR ; AC1,INSTR
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC13,AC1 ; OPND,AC1
JUMPN AC14,L.156 ; FLG,L.156
MOVEI AC1,1 ; AC1,1
JRST L.157 ; L.157
L.156: SETZ AC1, ; AC1,
L.157: HLRZ AC2,AC13 ; AC2,OPND
ADD AC1,AC2 ; AC1,AC2
PUSHJ SP,PCEAST ; SP,PCEAST
MOVE AC11,AC1 ; SV,AC1
MOVEI AC1,0(AC13) ; HLF,0(OPND)
HRLI AC1,-337100 ; HLF,-337100
MOVE AC4,AC1 ; PTRI,HLF
MOVEI AC1,0(AC11) ; HLF,0(SV)
HRLI AC1,-337100 ; HLF,-337100
MOVE AC2,AC1 ; PTRO,HLF
HLRZ AC12,AC11 ; CNT,SV
HLRZ AC3,AC13 ; I,OPND
JRST L.160 ; L.160
L.158: ILDB AC1,AC4 ; CHR,PTRI
CAIN AC1,12 ; CHR,12
JRST L.159 ; L.159
IDPB AC1,AC2 ; CHR,PTRO
JRST L.160 ; L.160
L.159: SUBI AC12,1 ; CNT,1
L.160: SOJGE AC3,L.158 ; I,L.158
JUMPN AC14,L.161 ; FLG,L.161
MOVEI AC1,15 ; AC1,15
IDPB AC1,AC2 ; AC1,PTRO
L.161: SETZ AC1, ; AC1,
IDPB AC1,AC2 ; AC1,PTRO
HRRZ AC1,INSTR ; AC1,INSTR
CAIE AC1,-100000 ; AC1,-100000
JRST L.162 ; L.162
MOVE AC1,AC13 ; AC1,OPND
PUSHJ SP,PCEFST ; SP,PCEFST
L.162: MOVEI AC1,0(AC11) ; HLF,0(SV)
HRLI AC1,-337100 ; HLF,-337100
MOVE AC2,AC12 ; AC2,CNT
PUSHJ SP,PCITIN ; SP,PCITIN
MOVE AC1,AC11 ; AC1,SV
PUSHJ SP,PCEFST ; SP,PCEFST
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
; 1838
; 1839 ROUTINE DOGTYO: NOVALUE = ! Gettypout instruction
; 1840
; 1841 !++
; 1842 ! Functional description:
; 1843 ! Obtains all output from user program accumulated since start
; 1844 ! (or since last call to this routine) and stores in operand A
; 1845 ! if not -1.
; 1846
; 1847 !
; 1848 ! Formal parameters:
; 1849 ! None
; 1850 !
; 1851 ! Implicit inputs:
; 1852 ! Accumulated output string block
; 1853 !
; 1854 ! Implicit outputs:
; 1855 ! User's string variable
; 1856 !
; 1857 ! Routine value:
; 1858 ! None
; 1859 !
; 1860 ! Side effects:
; 1861 ! None
; 1862 !
; 1863 !--
; 1864
; 1865 BEGIN
; 1866 EXTERNAL REGISTER Z;
; 1867 LOCAL
; 1868 PTR: REF STB_BLK, ! String block
; 1869 OPV: STR_VAL; ! Stringvalue being created
; 1870 BUILTIN MACHOP;
; 1871 REGISTER R1=1;
; 1872 PCIPSO();
; 1873 R1 = 0;
; 1874 ! I wish there were still an EXCH primitive
; 1875 MACHOP(%O'250',R1,PCPOTP);
; 1876 PTR = .R1;
; 1877 IF .PTR EQL 0
; 1878 THEN
; 1879 OPV = 0
; 1880 ELSE
; 1881 IF .PTR LSS 0
; 1882 THEN
; 1883 ERROR('Exec ran out of space storing typeout')
; 1884 ELSE
; 1885 BEGIN
; 1886 IF .INSTR[COD_OPA] NEQ %O'777777'
; 1887 THEN
; 1888 BEGIN
; 1889 OPV = PCEAST(.PTR[STB_CNT]);
; 1890 CH$COPY(.PTR[STB_CNT], BYTPTR(PTR[STB_BUF]),
; 1891 0, .OPV[STV_LEN]+1, BYTPTR(.OPV[STV_ADR]))
; 1892 END;
; 1893 RETMEM(.PTR[STB_LEN], .PTR, XDICT)
; 1894 END;
; 1895 IF .INSTR[COD_OPA] NEQ %O'777777'
; 1896 THEN
; 1897 PCESOP(.INSTR[COD_OPA], .OPV, STE_TYP_STR)
; 1898 END;
P.ABF: BYTE (7)"E","x","e","c"," " ; Exec
BYTE (7)"r","a","n"," ","o" ; ran o
BYTE (7)"u","t"," ","o","f" ; ut of
BYTE (7)" ","s","p","a","c" ; spac
BYTE (7)"e"," ","s","t","o" ; e sto
BYTE (7)"r","i","n","g"," " ; ring
BYTE (7)"t","y","p","e","o" ; typeo
BYTE (7)"u","t",000,000,000 ; ut
DOGTYO: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
PUSHJ SP,PCIPSO ; SP,PCIPSO
SETZ AC1, ; R1,
EXCH AC1,PCPOTP ; R1,PCPOTP
MOVE AC14,AC1 ; PTR,R1
JUMPN AC14,L.163 ; PTR,L.163
SETZ AC13, ; OPV,
JRST L.166 ; L.166
L.163: JUMPGE AC14,L.164 ; PTR,L.164
MOVEI AC1,P.ABF ; AC1,P.ABF
PUSHJ SP,PCEERR ; SP,PCEERR
JRST L.166 ; L.166
L.164: HRRZ AC1,INSTR ; AC1,INSTR
CAIN AC1,-1 ; AC1,-1
JRST L.165 ; L.165
HLRZ AC1,0(AC14) ; AC1,0(PTR)
PUSHJ SP,PCEAST ; SP,PCEAST
MOVE AC13,AC1 ; OPV,AC1
MOVE AC2,AC14 ; HLF,PTR
ADDI AC2,1 ; HLF,1
HRLI AC2,-337100 ; HLF,-337100
HLRZ AC4,AC13 ; AC4,OPV
ADDI AC4,1 ; AC4,1
MOVEI AC5,0(AC13) ; HLF,0(OPV)
HRLI AC5,-337100 ; HLF,-337100
HLRZ AC1,0(AC14) ; AC1,0(PTR)
EXTEND AC1,C.3 ; AC1,C.3
JFCL ;
L.165: HRRZ AC1,0(AC14) ; AC1,0(PTR)
MOVE AC2,AC14 ; AC2,PTR
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
L.166: HRRZ AC1,INSTR ; AC1,INSTR
CAIN AC1,-1 ; AC1,-1
JRST L.167 ; L.167
MOVE AC2,AC13 ; AC2,OPV
MOVEI AC3,1 ; AC3,1
PUSHJ SP,PCESOP ; SP,PCESOP
L.167: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 42 words
; 1899
; 1900 ROUTINE DODPLY(FLG,TYP): NOVALUE = ! Display instruction
; 1901
; 1902 !++
; 1903 ! Functional description:
; 1904 ! Display string in operand A on real terminal.
; 1905 !
; 1906 ! Formal parameters:
; 1907 ! 0 for normal display, 1 for binary, -1 for normal without CRLF
; 1908 ! GST_TYP_INT or GST_TYP_STR (type of value being displayed)
; 1909 !
; 1910 ! Implicit inputs:
; 1911 ! Instruction, operand
; 1912 !
; 1913 ! Implicit outputs:
; 1914 ! None
; 1915 !
; 1916 ! Routine value:
; 1917 ! None
; 1918 !
; 1919 ! Side effects:
; 1920 ! None
; 1921 !
; 1922 !--
; 1923
; 1924 BEGIN
; 1925 EXTERNAL REGISTER Z;
; 1926 LOCAL
; 1927 OPNS: STR_VAL, ! Operand (if a string)
; 1928 OPNI; ! Operand (if an integer)
; 1929 IF .TYP EQL GST_TYP_STR
; 1930 THEN
; 1931 BEGIN
; 1932 OPNS = PCEGOP(.INSTR[COD_OPA],STE_TYP_STR);
; 1933 PCIDPY(.OPNS[STV_ADR], .OPNS[STV_LEN], .FLG, .TYP);
; 1934 IF .INSTR[COD_OPA] EQL OPN_TMP_STR THEN PCEFST(.OPNS)
; 1935 END
; 1936 ELSE ! Integer
; 1937 BEGIN
; 1938 OPNI = PCEGOP(.INSTR[COD_OPA],STE_TYP_INT);
; 1939 PCIDPY(.OPNI, 0, .FLG, .TYP);
; 1940 END
; 1941 END;
DODPLY: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC2 ; TYP,AC2
MOVE AC13,AC1 ; FLG,AC1
CAIE AC14,1 ; TYP,1
JRST L.168 ; L.168
HRRZ AC1,INSTR ; AC1,INSTR
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC12,AC1 ; OPNS,AC1
MOVEI AC1,0(AC12) ; AC1,0(OPNS)
HLRZ AC2,AC12 ; AC2,OPNS
MOVE AC3,AC13 ; AC3,FLG
MOVE AC4,AC14 ; AC4,TYP
PUSHJ SP,PCIDPY ; SP,PCIDPY
HRRZ AC1,INSTR ; AC1,INSTR
CAIE AC1,-100000 ; AC1,-100000
JRST L.169 ; L.169
MOVE AC1,AC12 ; AC1,OPNS
PUSHJ SP,PCEFST ; SP,PCEFST
JRST L.169 ; L.169
L.168: HRRZ AC1,INSTR ; AC1,INSTR
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
SETZ AC2, ; AC2,
MOVE AC3,AC13 ; AC3,FLG
MOVE AC4,AC14 ; AC4,TYP
PUSHJ SP,PCIDPY ; SP,PCIDPY
L.169: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 33 words
; 1942
; 1943 ROUTINE CLIPRC: NOVALUE = ! Call internal routine
; 1944
; 1945 !++
; 1946 ! Functional description:
; 1947 ! After slightly validating the operands, this routine invokes
; 1948 ! the requested system procedure, passing it the user's
; 1949 ! argument list, and storing the value if the procedure returns one.
; 1950 !
; 1951 ! Formal parameters:
; 1952 ! None
; 1953 !
; 1954 ! Implicit inputs:
; 1955 ! PC, instruction word, symbol table, definition table
; 1956 !
; 1957 ! Implicit outputs:
; 1958 ! None
; 1959 !
; 1960 ! Routine value:
; 1961 ! None
; 1962 !
; 1963 ! Side effects:
; 1964 ! None
; 1965 !
; 1966 !--
; 1967
; 1968 %( Needs optimization of PSDEFN reference )%
; 1969
; 1970 BEGIN
; 1971 EXTERNAL REGISTER Z;
; 1972 LOCAL
; 1973 ARG,
; 1974 CNT,
; 1975 RTN: OPRAND,
; 1976 IDX,
; 1977 VAL;
; 1978 ARG = .INSTR[COD_OPB];
; 1979 IF .ARG EQL %O'777777' THEN CNT = 0 ELSE CNT = .CURCNS[.ARG];
; 1980 ARG = .ARG + .CURCNS + 1;
; 1981 RTN[OPN_WRD] = .INSTR[COD_OPA];
; 1982 IDX = .RTN[OPN_ADR];
; 1983 IF .IDX GEQ PSDEFL THEN ERROR('Bad system procedure index');
; 1984 IF .PSDEFN[.IDX,SYN_CLS] EQL SYN_CLS_VAR THEN ERROR('Not a procedure');
; 1985 VAL = EXEC(.PSDEFN[.IDX,SYN_ADR],.ARG,.CNT);
; 1986 IF .PSDEFN[.IDX,SYN_CLS] GEQ SYN_CLS_FCN
; 1987 THEN
; 1988 PCESOP(.INSTR[COD_OPC], .VAL, .PSDEFN[.IDX,SYN_TYP])
; 1989 END;
P.ABG: BYTE (7)"B","a","d"," ","s" ; Bad s
BYTE (7)"y","s","t","e","m" ; ystem
BYTE (7)" ","p","r","o","c" ; proc
BYTE (7)"e","d","u","r","e" ; edure
BYTE (7)" ","i","n","d","e" ; inde
BYTE (7)"x",000,000,000,000 ; x
P.ABH: BYTE (7)"N","o","t"," ","a" ; Not a
BYTE (7)" ","p","r","o","c" ; proc
BYTE (7)"e","d","u","r","e" ; edure
BYTE (7)000,000,000,000,000
CLIPRC: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
HLRZ AC13,INSTR+1 ; ARG,INSTR+1
CAIE AC13,-1 ; ARG,-1
JRST L.170 ; L.170
SETZ AC12, ; CNT,
JRST L.171 ; L.171
L.170: MOVE AC1,CURCNS ; AC1,CURCNS
ADD AC1,AC13 ; AC1,ARG
MOVE AC12,0(AC1) ; CNT,0(AC1)
L.171: MOVE AC1,AC13 ; AC1,ARG
ADD AC1,CURCNS ; AC1,CURCNS
MOVE AC13,AC1 ; ARG,AC1
ADDI AC13,1 ; ARG,1
HRRZ AC1,INSTR ; RTN,INSTR
LDB AC14,C.20 ; IDX,[POINT 15,AC1,35] <0,15>
CAIGE AC14,PSDEFL ; IDX,PSDEFL
JRST L.172 ; L.172
MOVEI AC1,P.ABG ; AC1,P.ABG
PUSHJ SP,PCEERR ; SP,PCEERR
L.172: IMULI AC14,2 ; IDX,2
LDB AC1,C.17 ; AC1,[POINT 3,PSDEFN(AC14),17] <18,3>
CAIE AC1,2 ; AC1,2
JRST L.173 ; L.173
MOVEI AC1,P.ABH ; AC1,P.ABH
PUSHJ SP,PCEERR ; SP,PCEERR
L.173: HRRZ AC3,PSDEFN+1(AC14) ; AC3,PSDEFN+1(AC14)
MOVE AC1,AC13 ; AC1,ARG
MOVE AC2,AC12 ; AC2,CNT
PUSHJ SP,0(AC3) ; SP,0(AC3)
MOVE AC2,AC1 ; VAL,AC1
LDB AC1,C.17 ; AC1,[POINT 3,PSDEFN(AC14),17] <18,3>
JUMPLE AC1,L.174 ; AC1,L.174
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
LDB AC3,C.18 ; AC3,[POINT 3,PSDEFN(AC14),14] <21,3>
PUSHJ SP,PCESOP ; SP,PCESOP
L.174: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 41 words
; 1990
; 1991 GLOBAL ROUTINE PCEXCT(XCTPTR) = ! Main executer loop
; 1992
; 1993 !++
; 1994 ! Functional description:
; 1995 ! This routine makes up the outer loop of the executer.
; 1996 ! It is called with the address of the Execution Context Block to
; 1997 ! be executed. After establishing the context defined there,
; 1998 ! it starts it running (or continues an execution interrupted by
; 1999 ! a DoCommand statement) by entering the fetch-execute cycle until
; 2000 ! it is terminated by a Return from the outermost procedure, or
; 2001 ! by a DoCommand statement. The return value indicates which case
; 2002 ! holds. It may be that execution was terminated by a DoCommand
; 2003 ! statement which generated more than one line; in that case, the
; 2004 ! next line is passed to the Exec and control returns immediately.
; 2005 !
; 2006 ! Formal parameters:
; 2007 ! Byte pointer to Command Buffer to be filled
; 2008 !
; 2009 ! Implicit inputs:
; 2010 ! Everything that matters
; 2011 !
; 2012 ! Implicit outputs:
; 2013 ! Everything that matters
; 2014 !
; 2015 ! Routine value:
; 2016 ! -1 or -2 if completed by Exit, number of characters inserted
; 2017 ! into Command Buffer if Perform, -3 to exit to the program.
; 2018 !
; 2019 ! Side effects:
; 2020 ! Uncountable and unpredictable
; 2021 !
; 2022 !--
; 2023
; 2024
; 2025 BEGIN
; 2026 EXTERNAL REGISTER Z;
; 2027 LOCAL
; 2028 OPR, ! Current instruction code
; 2029 OPAV: STR_VAL, ! Temporaries for operands
; 2030 OPBV: STR_VAL,
; 2031 OPCV: STR_VAL,
; 2032 HALTCD, ! Halt code
; 2033 ECB: REF ECB_BLK; ! Temporary for current Execution Context Block
; 2034 LABEL
; 2035 HALTEX; ! Stop execution
; 2036 ECB = .PCCURC;
; 2037 CMPTR = .XCTPTR;
; 2038 IF .ECB[ECB_DCB] NEQ 0 THEN RETURN PUTDCL();
; 2039 CURGST = .ECB[ECB_PRC];
; 2040 SETCTX();
; 2041 PC = .ECB[ECB_PC];
; 2042 STKP = .ECB[ECB_SP];
; 2043 FP = .ECB[ECB_FP];
; 2044 IF .FP EQL 0
; 2045 THEN
; 2046 BEGIN
; 2047 LOCAL
; 2048 GST: REF GST_BLK, ! Global symbol table entry
; 2049 PTR; ! Temporary
; 2050 PTR = .ECB[ECB_STK];
; 2051 FP = .PTR;
; 2052 PTR = .PTR + PCSTAK + FRM_LOC;
; 2053 GST = .CURGST;
; 2054 DECR I FROM .GST[GST_SLN]-1 DO
; 2055 BEGIN
; 2056 .PTR = 0;
; 2057 PTR = .PTR + 1
; 2058 END;
; 2059 IF .GST[GST_CMA] GEQ -1
; 2060 THEN
; 2061 DOCARG(.GST[GST_CMA]);
; 2062 END
; 2063 ELSE
; 2064 IF .ECB[ECB_DTO] NEQ %O'777777' THEN GETEOP();
; 2065
; 2066 HALTCD =
; 2067 HALTEX:(WHILE .PC GEQ 0 DO
; 2068 BEGIN
; 2069 IF .PC GTR .CURCDL THEN ERROR('PC out of bounds');
; 2070 INSTR = .CURCOD[.PC,COD_CNS];
; 2071 INSTR+1 = .CURCOD[.PC+1,COD_CNS];
; 2072 IF .INSTR[COD_VLD] NEQ COD_VLD_NUM
; 2073 THEN
; 2074 ERROR('Jump to non-instruction');
; 2075 OPR = .INSTR[COD_OPR];
; 2076 IF .OPR LSS 0 OR .OPR GTR OPR_LST THEN ERROR('Illegal operation code');
; 2077 PC = .PC+1;
; 2078 IF .OPR LSS OPR_11W THEN PC = .PC+1;
; 2079 IF .OPR GEQ OPR_ADD AND .OPR LEQ OPR_DIV THEN
; 2080 BEGIN
; 2081 ! Must fetch C before B because if they are temporaries
; 2082 ! B will have been generated (and pushed) before C
; 2083 OPCV = PCEGOP(.INSTR[COD_OPC],STE_TYP_INT);
; 2084 OPBV = PCEGOP(.INSTR[COD_OPB],STE_TYP_INT);
; 2085 OPAV = (CASE .OPR FROM OPR_ADD TO OPR_DIV OF
; 2086 SET
; 2087 [OPR_ADD]: .OPBV + .OPCV;
; 2088 [OPR_SUB]: .OPBV - .OPCV;
; 2089 [OPR_MUL]: .OPBV * .OPCV;
; 2090 [OPR_DIV]: .OPBV / .OPCV;
; 2091 TES);
; 2092 PCESOP(.INSTR[COD_OPA],.OPAV,STE_TYP_INT)
; 2093 END ELSE
; 2094 IF .OPR EQL OPR_CNS
; 2095 THEN
; 2096 BEGIN
; 2097 OPCV = PCEGOP(.INSTR[COD_OPC],STE_TYP_STR);
; 2098 OPBV = PCEGOP(.INSTR[COD_OPB],STE_TYP_STR);
; 2099 OPAV = PCEAST(.OPBV[STV_LEN] + .OPCV[STV_LEN]);
; 2100 CH$COPY(.OPBV[STV_LEN], BYTPTR(.OPBV[STV_ADR]),
; 2101 .OPCV[STV_LEN], BYTPTR(.OPCV[STV_ADR]),
; 2102 0, .OPBV[STV_LEN]+.OPCV[STV_LEN]+1,BYTPTR(.OPAV[STV_ADR]));
; 2103 IF .INSTR[COD_OPB] EQL OPN_TMP_STR THEN PCEFST(.OPBV);
; 2104 IF .INSTR[COD_OPC] EQL OPN_TMP_STR THEN PCEFST(.OPCV);
; 2105 PCESOP(.INSTR[COD_OPA],.OPAV,STE_TYP_STR)
; 2106 END
; 2107 ELSE
; 2108 IF .OPR EQL OPR_STO
; 2109 THEN
; 2110 PCESOP(.INSTR[COD_OPA],
; 2111 PCEGOP(.INSTR[COD_OPC],STE_TYP_INT),STE_TYP_INT)
; 2112 ELSE
; 2113 IF .OPR EQL OPR_STS
; 2114 THEN
; 2115 BEGIN
; 2116 OPCV = PCEGOP(.INSTR[COD_OPC],STE_TYP_STR);
; 2117 IF .INSTR[COD_OPC] NEQ OPN_TMP_STR THEN OPCV = PCECST(.OPCV);
; 2118 PCESOP ( .INSTR[COD_OPA], .OPCV, STE_TYP_STR)
; 2119 END
; 2120 ELSE
; 2121 IF .OPR GEQ OPR_BLE AND .OPR LEQ OPR_BGT THEN
; 2122 BEGIN
; 2123 OPAV = .INSTR[COD_OPA];
; 2124 OPCV = PCEGOP(.INSTR[COD_OPC],STE_TYP_INT);
; 2125 OPBV = PCEGOP(.INSTR[COD_OPB],STE_TYP_INT);
; 2126 CASE .OPR FROM OPR_BLE TO OPR_BGT OF
; 2127 SET
; 2128 [OPR_BLE]: IF .OPBV LEQ .OPCV THEN PC = .OPAV;
; 2129 [OPR_BLT]: IF .OPBV LSS .OPCV THEN PC = .OPAV;
; 2130 [OPR_BEQ]: IF .OPBV EQL .OPCV THEN PC = .OPAV;
; 2131 [OPR_BNE]: IF .OPBV NEQ .OPCV THEN PC = .OPAV;
; 2132 [OPR_BGE]: IF .OPBV GEQ .OPCV THEN PC = .OPAV;
; 2133 [OPR_BGT]: IF .OPBV GTR .OPCV THEN PC = .OPAV;
; 2134 TES
; 2135 END ELSE
; 2136 IF .OPR GEQ OPR_CLE AND .OPR LEQ OPR_CGT THEN
; 2137 BEGIN
; 2138 LOCAL
; 2139 OPBL,
; 2140 OPCL,
; 2141 OPBP,
; 2142 OPCP;
; 2143 OPCV = PCEGOP(.INSTR[COD_OPC],STE_TYP_STR);
; 2144 OPCL = .OPCV[STV_LEN];
; 2145 OPCP = BYTPTR(.OPCV[STV_ADR]);
; 2146 OPBV = PCEGOP(.INSTR[COD_OPB],STE_TYP_STR);
; 2147 OPBL = .OPBV[STV_LEN];
; 2148 OPBP = BYTPTR(.OPBV[STV_ADR]);
; 2149 IF (CASE .OPR FROM OPR_CLE TO OPR_CGT OF
; 2150 SET
; 2151 [OPR_CLE]: CH$LEQ(.OPBL,.OPBP,.OPCL,.OPCP);
; 2152 [OPR_CLT]: CH$LSS(.OPBL,.OPBP,.OPCL,.OPCP);
; 2153 [OPR_CEQ]: CH$EQL(.OPBL,.OPBP,.OPCL,.OPCP);
; 2154 [OPR_CNE]: CH$NEQ(.OPBL,.OPBP,.OPCL,.OPCP);
; 2155 [OPR_CGE]: CH$GEQ(.OPBL,.OPBP,.OPCL,.OPCP);
; 2156 [OPR_CGT]: CH$GTR(.OPBL,.OPBP,.OPCL,.OPCP);
; 2157 TES) THEN PC = .INSTR[COD_OPA];
; 2158 IF .INSTR[COD_OPB] EQL OPN_TMP_STR THEN PCEFST(.OPBV);
; 2159 IF .INSTR[COD_OPC] EQL OPN_TMP_STR THEN PCEFST(.OPCV)
; 2160 END
; 2161 ELSE
; 2162 CASE .OPR FROM OPR_CAL TO OPR_DIN OF
; 2163 SET
; 2164 [OPR_CAL]: BEGIN
; 2165 LOCAL
; 2166 OPN: OPRAND;
; 2167 OPN[OPN_WRD]=.INSTR[COD_OPA];
; 2168 IF .OPN[OPN_CLS] EQL OPN_CLS_SYN
; 2169 THEN
; 2170 CLIPRC()
; 2171 ELSE
; 2172 CALPRC()
; 2173 END;
; 2174 [OPR_SBS]: DOSBSS();
; 2175 [OPR_DCM]: LEAVE HALTEX WITH DOCMND();
; 2176 [OPR_PRS]: DPARSE();
; 2177 [OPR_JMP]: PC = .INSTR[COD_OPA];
; 2178 [OPR_RET]: IF .FP EQL .ECB[ECB_STK]
; 2179 THEN
; 2180 LEAVE HALTEX WITH -1
; 2181 ELSE
; 2182 RETPRC();
; 2183 [OPR_CAS]: DOCASE();
; 2184 [OPR_IVP,
; 2185 OPR_IVO]: BEGIN
; 2186 OPAV = PCEGOP(.INSTR[COD_OPA],STE_TYP_STR);
; 2187 PCIIVK(.OPAV,(IF .OPR EQL OPR_IVP THEN 0 ELSE 1));
; 2188 IF .INSTR[COD_OPA] EQL OPN_TMP_STR THEN PCEFST(.OPAV)
; 2189 END;
; 2190 [OPR_TIN]: DOTINP(0);
; 2191 [OPR_TIX]: DOTINP(1);
; 2192 [OPR_GTO]: DOGTYO();
; 2193 [OPR_KIL]: PCIKIF();
; 2194 [OPR_DPY]: DODPLY(0,GST_TYP_STR);
; 2195 [OPR_DPB]: DODPLY(1,GST_TYP_STR);
; 2196 [OPR_DPN]: DODPLY(-1,GST_TYP_STR);
; 2197 [OPR_DIY]: DODPLY(0,GST_TYP_INT);
; 2198 [OPR_DIB]: DODPLY(1,GST_TYP_INT);
; 2199 [OPR_DIN]: DODPLY(-1,GST_TYP_INT);
; 2200 [OPR_XIT]: LEAVE HALTEX WITH -.INSTR[COD_OPA]-1;
; 2201 [OPR_ABT]: BEGIN
; 2202 OPAV = PCEGOP(.INSTR[COD_OPA],STE_TYP_STR);
; 2203 IF .OPAV NEQ 0
; 2204 THEN
; 2205 BEGIN
; 2206 LOCAL
; 2207 PTRO,
; 2208 CHR;
; 2209 OPAV = BYTPTR(.OPAV[STV_ADR]);
; 2210 PTRO = BYTPTR(.CSBUFP[STV_ADR]+1);
; 2211 DO (CHR=CH$RCHAR_A(OPAV); CH$WCHAR_A(.CHR,PTRO))
; 2212 WHILE .CHR NEQ $CHNUL;
; 2213 OPAV = .CSBUFP[STV_ADR]+1
; 2214 END;
; 2215 PCICLP(1);
; 2216 CLNVAR();
; 2217 PCMXER(.OPAV)
; 2218 END;
; 2219 [OPR_NOP]: ;
; 2220 [OPR_PSH]: BEGIN
; 2221 OPAV = .PCSTAK[.STKP,FRM_WRD];
; 2222 IF .INSTR[COD_OPA] EQL OPN_TMP_STR
; 2223 THEN
; 2224 OPAV = PCECST(.OPAV);
; 2225 IF .STKP EQL STAKLN
; 2226 THEN
; 2227 ERROR('Stack full');
; 2228 STKP = .STKP + 1;
; 2229 PCSTAK[.STKP,FRM_WRD] = .OPAV
; 2230 END;
; 2231 [OPR_POP]: BEGIN
; 2232 OPAV = .PCSTAK[.STKP,FRM_WRD];
; 2233 STKP = .STKP - 1;
; 2234 IF .INSTR[COD_OPA] EQL OPN_TMP_STR THEN PCEFST(.OPAV)
; 2235 END;
; 2236 [OPR_PMT,OPR_PMN]:
; 2237 DPRMPT()
; 2238 TES
; 2239 END);
; 2240 !+
; 2241 ! Execution is finished, at least for now. The termination codes are:
; 2242 ! positive: DoCommand
; 2243 ! -1: Exit after cleanup
; 2244 ! -2: Exit but don't kill the program fork
; 2245 ! -3: Exit to the program
; 2246 ! If the termination code is -2 or -3 then we make the invoked program
; 2247 ! be the current fork (by setting FORK to its fork handle).
; 2248 !-
; 2249 IF .PCCURC[ECB_PAR] NEQ 0
; 2250 THEN
; 2251 BEGIN
; 2252 IF PCIPRS(CFM_FLDDB,0) LSS 0 THEN PCMPER(0);
; 2253 PCCURC[ECB_PAR] = 0
; 2254 END;
; 2255 IF .HALTCD LSS 0
; 2256 THEN
; 2257 BEGIN
; 2258 IF .HALTCD EQL -2 OR .HALTCD EQL -3
; 2259 THEN
; 2260 BEGIN
; 2261 FORK = .ECB[ECB_CFK];
; 2262 PCFORK = -2;
; 2263 PCRNFK = -2;
; 2264 CLRINV(.FORK); ! Fork is no longer INVOKE'd
; 2265 END;
; 2266 PCICLP((IF .HALTCD EQL -1 THEN -1 ELSE 0));
; 2267 CLNVAR();
; 2268 STKP = .ECB[ECB_STK] - 1
; 2269 END
; 2270 ELSE
; 2271 BEGIN
; 2272 ECB[ECB_PRC] = .CURGST;
; 2273 ECB[ECB_PC] = .PC;
; 2274 ECB[ECB_FP] = .FP;
; 2275 ECB[ECB_SP] = .STKP
; 2276 END;
; 2277 .HALTCD
; 2278 END;
P.ABI: BYTE (7)"P","C"," ","o","u" ; PC ou
BYTE (7)"t"," ","o","f"," " ; t of
BYTE (7)"b","o","u","n","d" ; bound
BYTE (7)"s",000,000,000,000 ; s
P.ABJ: BYTE (7)"J","u","m","p"," " ; Jump
BYTE (7)"t","o"," ","n","o" ; to no
BYTE (7)"n","-","i","n","s" ; n-ins
BYTE (7)"t","r","u","c","t" ; truct
BYTE (7)"i","o","n",000,000 ; ion
P.ABK: BYTE (7)"I","l","l","e","g" ; Illeg
BYTE (7)"a","l"," ","o","p" ; al op
BYTE (7)"e","r","a","t","i" ; erati
BYTE (7)"o","n"," ","c","o" ; on co
BYTE (7)"d","e",000,000,000 ; de
P.ABL: BYTE (7)"S","t","a","c","k" ; Stack
BYTE (7)" ","f","u","l","l" ; full
BYTE (7)000,000,000,000,000
PCEXCT::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
MOVE AC14,PCCURC ; ECB,PCCURC
MOVEM AC1,CMPTR ; XCTPTR,CMPTR
HRRZ AC1,6(AC14) ; AC1,6(ECB)
JUMPE AC1,L.175 ; AC1,L.175
PUSHJ SP,PUTDCL ; SP,PUTDCL
JRST L.266 ; L.266
L.175: HLRZ AC1,0(AC14) ; AC1,0(ECB)
MOVEM AC1,CURGST ; AC1,CURGST
PUSHJ SP,SETCTX ; SP,SETCTX
HRRZ AC1,2(AC14) ; AC1,2(ECB)
MOVEM AC1,PC ; AC1,PC
HRRZ AC1,3(AC14) ; AC1,3(ECB)
MOVEM AC1,STKP ; AC1,STKP
HLRZ AC1,2(AC14) ; AC1,2(ECB)
MOVEM AC1,FP ; AC1,FP
SKIPE FP ; FP
JRST L.178 ; L.178
HLRZ AC1,3(AC14) ; PTR,3(ECB)
MOVEM AC1,FP ; PTR,FP
ADD AC1,C.54 ; PTR,[PCSTAK+2]
MOVE AC2,CURGST ; GST,CURGST
LDB AC3,C.46 ; I,[POINT 8,0(GST),17] <18,8>
JRST L.177 ; L.177
L.176: SETZM 0(AC1) ; 0(PTR)
ADDI AC1,1 ; PTR,1
L.177: SOJGE AC3,L.176 ; I,L.176
LDB AC1,C.32 ; AC1,[POINT 4,0(AC2),9] <26,4>
TRC AC1,10 ; AC1,10
SUBI AC1,10 ; AC1,10
CAMGE AC1,C.36 ; AC1,[-1]
JRST L.179 ; L.179
LDB AC1,C.32 ; AC1,[POINT 4,0(AC2),9] <26,4>
TRC AC1,10 ; AC1,10
SUBI AC1,10 ; AC1,10
PUSHJ SP,DOCARG ; SP,DOCARG
JRST L.179 ; L.179
L.178: HLRZ AC1,6(AC14) ; AC1,6(ECB)
CAIE AC1,-1 ; AC1,-1
PUSHJ SP,GETEOP ; SP,GETEOP
L.179: MOVE AC1,PC ; AC1,PC
JUMPL AC1,L.256 ; AC1,L.256
CAMG AC1,CURCDL ; AC1,CURCDL
JRST L.180 ; L.180
MOVEI AC1,P.ABI ; AC1,P.ABI
PUSHJ SP,PCEERR ; SP,PCEERR
L.180: MOVE AC2,CURCOD ; AC2,CURCOD
MOVE AC1,PC ; AC1,PC
ADD AC2,AC1 ; AC2,AC1
MOVE AC1,0(AC2) ; AC1,0(AC2)
MOVEM AC1,INSTR ; AC1,INSTR
MOVE AC1,CURCOD ; AC1,CURCOD
MOVE AC2,PC ; AC2,PC
ADD AC1,AC2 ; AC1,AC2
MOVE AC2,1(AC1) ; AC2,1(AC1)
MOVEM AC2,INSTR+1 ; AC2,INSTR+1
LDB AC1,C.47 ; AC1,[POINT 3,INSTR,2] <33,3>
CAIN AC1,5 ; AC1,5
JRST L.181 ; L.181
MOVEI AC1,P.ABJ ; AC1,P.ABJ
PUSHJ SP,PCEERR ; SP,PCEERR
L.181: LDB AC10,C.43 ; OPR,[POINT 6,INSTR,17] <18,6>
JUMPL AC10,L.182 ; OPR,L.182
CAIG AC10,54 ; OPR,54
JRST L.183 ; L.183
L.182: MOVEI AC1,P.ABK ; AC1,P.ABK
PUSHJ SP,PCEERR ; SP,PCEERR
L.183: AOS PC ; PC
CAIGE AC10,30 ; OPR,30
AOS PC ; PC
JUMPL AC10,L.190 ; OPR,L.190
CAILE AC10,3 ; OPR,3
JRST L.190 ; L.190
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,-1(SP) ; AC1,OPCV
HLRZ AC1,INSTR+1 ; AC1,INSTR+1
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,0(SP) ; AC1,OPBV
JRST L.184(AC10) ; L.184(OPR)
L.184: JRST L.185 ; L.185
JRST L.186 ; L.186
JRST L.187 ; L.187
JRST L.188 ; L.188
L.185: MOVE AC11,0(SP) ; OPAV,OPBV
ADD AC11,-1(SP) ; OPAV,OPCV
JRST L.189 ; L.189
L.186: MOVE AC11,0(SP) ; OPAV,OPBV
SUB AC11,-1(SP) ; OPAV,OPCV
JRST L.189 ; L.189
L.187: MOVE AC11,0(SP) ; OPAV,OPBV
IMUL AC11,-1(SP) ; OPAV,OPCV
JRST L.189 ; L.189
L.188: MOVE AC1,0(SP) ; AC1,OPBV
IDIV AC1,-1(SP) ; AC1,OPCV
MOVE AC11,AC1 ; OPAV,AC1
L.189: HRRZ AC1,INSTR ; AC1,INSTR
MOVE AC2,AC11 ; AC2,OPAV
JRST L.195 ; L.195
L.190: CAIE AC10,4 ; OPR,4
JRST L.194 ; L.194
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,-1(SP) ; AC1,OPCV
HLRZ AC1,INSTR+1 ; AC1,INSTR+1
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,0(SP) ; AC1,OPBV
HLRZ AC12,0(SP) ; AC12,OPBV
HLRZ AC1,-1(SP) ; AC1,OPCV
ADD AC12,AC1 ; AC12,AC1
MOVE AC1,AC12 ; AC1,AC12
PUSHJ SP,PCEAST ; SP,PCEAST
MOVE AC11,AC1 ; OPAV,AC1
HRRZ AC2,0(SP) ; HLF,OPBV
HRLI AC2,-337100 ; HLF,-337100
HRRZ AC3,-1(SP) ; HLF,OPCV
HRLI AC3,-337100 ; HLF,-337100
ADDI AC12,1 ; AC12,1
MOVEI AC5,0(AC11) ; HLF,0(OPAV)
HRLI AC5,-337100 ; HLF,-337100
HLRZ AC1,0(SP) ; AC1,OPBV
MOVE AC4,AC12 ; AC4,AC12
CAML AC4,AC1 ; AC4,AC1
MOVE AC4,AC1 ; AC4,AC1
SUB AC12,AC4 ; AC12,AC4
EXTEND AC1,C.22 ; AC1,[MOVSLJ ]
JFCL ;
JUMPLE AC12,L.191 ; AC12,L.191
HLRZ AC1,-1(SP) ; AC1,OPCV
MOVE AC2,AC3 ; AC2,HLF
MOVE AC4,AC12 ; AC4,AC12
EXTEND AC1,C.3 ; AC1,C.3
JFCL ;
L.191: HLRZ AC1,INSTR+1 ; AC1,INSTR+1
CAIE AC1,-100000 ; AC1,-100000
JRST L.192 ; L.192
MOVE AC1,0(SP) ; AC1,OPBV
PUSHJ SP,PCEFST ; SP,PCEFST
L.192: HRRZ AC1,INSTR+1 ; AC1,INSTR+1
CAIE AC1,-100000 ; AC1,-100000
JRST L.193 ; L.193
MOVE AC1,-1(SP) ; AC1,OPCV
PUSHJ SP,PCEFST ; SP,PCEFST
L.193: HRRZ AC1,INSTR ; AC1,INSTR
MOVE AC2,AC11 ; AC2,OPAV
JRST L.198 ; L.198
L.194: CAIE AC10,5 ; OPR,5
JRST L.196 ; L.196
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC2,AC1 ; AC2,AC1
HRRZ AC1,INSTR ; AC1,INSTR
L.195: SETZ AC3, ; AC3,
JRST L.199 ; L.199
L.196: CAIE AC10,6 ; OPR,6
JRST L.200 ; L.200
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,-1(SP) ; AC1,OPCV
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
CAIN AC1,-100000 ; AC1,-100000
JRST L.197 ; L.197
MOVE AC1,-1(SP) ; AC1,OPCV
PUSHJ SP,PCECST ; SP,PCECST
MOVEM AC1,-1(SP) ; AC1,OPCV
L.197: HRRZ AC1,INSTR ; AC1,INSTR
MOVE AC2,-1(SP) ; AC2,OPCV
L.198: MOVEI AC3,1 ; AC3,1
L.199: PUSHJ SP,PCESOP ; SP,PCESOP
JRST L.179 ; L.179
L.200: CAIL AC10,7 ; OPR,7
CAILE AC10,14 ; OPR,14
JRST L.209 ; L.209
HRRZ AC11,INSTR ; OPAV,INSTR
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,-1(SP) ; AC1,OPCV
HLRZ AC1,INSTR+1 ; AC1,INSTR+1
SETZ AC2, ; AC2,
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,0(SP) ; AC1,OPBV
MOVE AC1,AC10 ; AC1,OPR
SUBI AC1,7 ; AC1,7
JRST L.201(AC1) ; L.201(AC1)
L.201: JRST L.202 ; L.202
JRST L.203 ; L.203
JRST L.204 ; L.204
JRST L.205 ; L.205
JRST L.206 ; L.206
JRST L.207 ; L.207
L.202: MOVE AC1,0(SP) ; AC1,OPBV
CAMLE AC1,-1(SP) ; AC1,OPCV
JRST L.179 ; L.179
JRST L.208 ; L.208
L.203: MOVE AC1,0(SP) ; AC1,OPBV
CAML AC1,-1(SP) ; AC1,OPCV
JRST L.179 ; L.179
JRST L.208 ; L.208
L.204: MOVE AC1,0(SP) ; AC1,OPBV
CAME AC1,-1(SP) ; AC1,OPCV
JRST L.179 ; L.179
JRST L.208 ; L.208
L.205: MOVE AC1,0(SP) ; AC1,OPBV
CAMN AC1,-1(SP) ; AC1,OPCV
JRST L.179 ; L.179
JRST L.208 ; L.208
L.206: MOVE AC1,0(SP) ; AC1,OPBV
CAMGE AC1,-1(SP) ; AC1,OPCV
JRST L.179 ; L.179
JRST L.208 ; L.208
L.207: MOVE AC1,0(SP) ; AC1,OPBV
CAMG AC1,-1(SP) ; AC1,OPCV
JRST L.179 ; L.179
L.208: MOVEM AC11,PC ; OPAV,PC
JRST L.179 ; L.179
L.209: CAIL AC10,15 ; OPR,15
CAILE AC10,22 ; OPR,22
JRST L.220 ; L.220
HRRZ AC1,INSTR+1 ; AC1,INSTR+1
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,-1(SP) ; AC1,OPCV
HLRZ AC12,-1(SP) ; OPCL,OPCV
HRRZ AC1,-1(SP) ; HLF,OPCV
HRLI AC1,-337100 ; HLF,-337100
MOVE AC13,AC1 ; OPCP,HLF
HLRZ AC1,INSTR+1 ; AC1,INSTR+1
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVEM AC1,0(SP) ; AC1,OPBV
HLRZ AC1,0(SP) ; OPBL,OPBV
HRRZ AC2,0(SP) ; HLF,OPBV
HRLI AC2,-337100 ; HLF,-337100
MOVE AC3,AC10 ; AC3,OPR
SUBI AC3,15 ; AC3,15
JRST L.210(AC3) ; L.210(AC3)
L.210: JRST L.211 ; L.211
JRST L.212 ; L.212
JRST L.213 ; L.213
JRST L.214 ; L.214
JRST L.215 ; L.215
JRST L.216 ; L.216
L.211: MOVE AC4,AC12 ; AC4,OPCL
MOVE AC5,AC13 ; AC5,OPCP
EXTEND AC1,C.48 ; AC1,C.48
JRST L.218 ; L.218
JRST L.217 ; L.217
L.212: MOVE AC4,AC12 ; AC4,OPCL
MOVE AC5,AC13 ; AC5,OPCP
EXTEND AC1,C.49 ; AC1,C.49
JRST L.218 ; L.218
JRST L.217 ; L.217
L.213: MOVE AC4,AC12 ; AC4,OPCL
MOVE AC5,AC13 ; AC5,OPCP
EXTEND AC1,C.50 ; AC1,C.50
JRST L.218 ; L.218
JRST L.217 ; L.217
L.214: MOVE AC4,AC12 ; AC4,OPCL
MOVE AC5,AC13 ; AC5,OPCP
EXTEND AC1,C.51 ; AC1,C.51
JRST L.218 ; L.218
JRST L.217 ; L.217
L.215: MOVE AC4,AC12 ; AC4,OPCL
MOVE AC5,AC13 ; AC5,OPCP
EXTEND AC1,C.52 ; AC1,C.52
JRST L.218 ; L.218
JRST L.217 ; L.217
L.216: MOVE AC4,AC12 ; AC4,OPCL
MOVE AC5,AC13 ; AC5,OPCP
EXTEND AC1,C.53 ; AC1,C.53
JRST L.218 ; L.218
L.217: HRRZ AC1,INSTR ; AC1,INSTR
MOVEM AC1,PC ; AC1,PC
L.218: HLRZ AC1,INSTR+1 ; AC1,INSTR+1
CAIE AC1,-100000 ; AC1,-100000
JRST L.219 ; L.219
MOVE AC1,0(SP) ; AC1,OPBV
PUSHJ SP,PCEFST ; SP,PCEFST
L.219: HRRZ AC1,INSTR+1 ; AC1,INSTR+1
CAIE AC1,-100000 ; AC1,-100000
JRST L.179 ; L.179
MOVE AC1,-1(SP) ; AC1,OPCV
JRST L.254 ; L.254
L.220: MOVE AC1,AC10 ; AC1,OPR
SUBI AC1,23 ; AC1,23
JRST L.221(AC1) ; L.221(AC1)
L.221: JRST L.222 ; L.222
JRST L.229 ; L.229
JRST L.226 ; L.226
JRST L.224 ; L.224
JRST L.225 ; L.225
JRST L.227 ; L.227
JRST L.228 ; L.228
JRST L.230 ; L.230
JRST L.231 ; L.231
JRST L.232 ; L.232
JRST L.233 ; L.233
JRST L.234 ; L.234
JRST L.235 ; L.235
JRST L.236 ; L.236
JRST L.237 ; L.237
JRST L.244 ; L.244
JRST L.246 ; L.246
JRST L.179 ; L.179
JRST L.249 ; L.249
JRST L.252 ; L.252
JRST L.255 ; L.255
JRST L.255 ; L.255
JRST L.230 ; L.230
JRST L.239 ; L.239
JRST L.240 ; L.240
JRST L.241 ; L.241
L.222: HRRZ AC1,INSTR ; OPN,INSTR
LDB AC2,C.21 ; AC2,[POINT 2,AC1,19] <16,2>
CAIE AC2,1 ; AC2,1
JRST L.223 ; L.223
PUSHJ SP,CLIPRC ; SP,CLIPRC
JRST L.179 ; L.179
L.223: PUSHJ SP,CALPRC ; SP,CALPRC
JRST L.179 ; L.179
L.224: PUSHJ SP,DOSBSS ; SP,DOSBSS
JRST L.179 ; L.179
L.225: PUSHJ SP,DOCMND ; SP,DOCMND
JRST L.245 ; L.245
L.226: PUSHJ SP,DPARSE ; SP,DPARSE
JRST L.179 ; L.179
L.227: HRRZ AC1,INSTR ; AC1,INSTR
MOVEM AC1,PC ; AC1,PC
JRST L.179 ; L.179
L.228: HLRZ AC1,3(AC14) ; AC1,3(ECB)
CAMN AC1,FP ; AC1,FP
JRST L.256 ; L.256
PUSHJ SP,RETPRC ; SP,RETPRC
JRST L.179 ; L.179
L.229: PUSHJ SP,DOCASE ; SP,DOCASE
JRST L.179 ; L.179
L.230: HRRZ AC1,INSTR ; AC1,INSTR
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC11,AC1 ; OPAV,AC1
CAIN AC10,32 ; OPR,32
TDZA AC2,AC2 ; AC2,AC2
MOVEI AC2,1 ; AC2,1
MOVE AC1,AC11 ; AC1,OPAV
PUSHJ SP,PCIIVK ; SP,PCIIVK
JRST L.253 ; L.253
L.231: TDZA AC1,AC1 ; AC1,AC1
L.232: MOVEI AC1,1 ; AC1,1
PUSHJ SP,DOTINP ; SP,DOTINP
JRST L.179 ; L.179
L.233: PUSHJ SP,DOGTYO ; SP,DOGTYO
JRST L.179 ; L.179
L.234: PUSHJ SP,PCIKIF ; SP,PCIKIF
JRST L.179 ; L.179
L.235: SETZ AC1, ; AC1,
JRST L.238 ; L.238
L.236: MOVEI AC1,1 ; AC1,1
JRST L.238 ; L.238
L.237: SETO AC1, ; AC1,
L.238: MOVEI AC2,1 ; AC2,1
JRST L.243 ; L.243
L.239: SETZ AC1, ; AC1,
JRST L.242 ; L.242
L.240: MOVEI AC1,1 ; AC1,1
JRST L.242 ; L.242
L.241: SETO AC1, ; AC1,
L.242: SETZ AC2, ; AC2,
L.243: PUSHJ SP,DODPLY ; SP,DODPLY
JRST L.179 ; L.179
L.244: SETO AC1, ; AC1,
HRRZ AC2,INSTR ; AC2,INSTR
SUB AC1,AC2 ; AC1,AC2
L.245: MOVE AC13,AC1 ; HALTCD,AC1
JRST L.257 ; L.257
L.246: HRRZ AC1,INSTR ; AC1,INSTR
MOVEI AC2,1 ; AC2,1
PUSHJ SP,PCEGOP ; SP,PCEGOP
MOVE AC11,AC1 ; OPAV,AC1
JUMPE AC11,L.248 ; OPAV,L.248
MOVEI AC1,0(AC11) ; HLF,0(OPAV)
HRLI AC1,-337100 ; HLF,-337100
MOVE AC11,AC1 ; OPAV,HLF
HRRZ AC1,CSBUFP ; HLF,CSBUFP
ADDI AC1,1 ; HLF,1
HRLI AC1,-337100 ; HLF,-337100
MOVE AC2,AC1 ; PTRO,HLF
L.247: ILDB AC1,AC11 ; CHR,OPAV
IDPB AC1,AC2 ; CHR,PTRO
JUMPN AC1,L.247 ; CHR,L.247
HRRZ AC11,CSBUFP ; OPAV,CSBUFP
ADDI AC11,1 ; OPAV,1
L.248: MOVEI AC1,1 ; AC1,1
PUSHJ SP,PCICLP ; SP,PCICLP
PUSHJ SP,CLNVAR ; SP,CLNVAR
MOVE AC1,AC11 ; AC1,OPAV
PUSHJ SP,PCMXER ; SP,PCMXER
JRST L.179 ; L.179
L.249: MOVE AC1,STKP ; AC1,STKP
MOVE AC11,PCSTAK(AC1) ; OPAV,PCSTAK(AC1)
HRRZ AC1,INSTR ; AC1,INSTR
CAIE AC1,-100000 ; AC1,-100000
JRST L.250 ; L.250
MOVE AC1,AC11 ; AC1,OPAV
PUSHJ SP,PCECST ; SP,PCECST
MOVE AC11,AC1 ; OPAV,AC1
L.250: MOVE AC1,STKP ; AC1,STKP
CAME AC1,C.55 ; AC1,[<PCSTKL*1000>]
JRST L.251 ; L.251
MOVEI AC1,P.ABL ; AC1,P.ABL
PUSHJ SP,PCEERR ; SP,PCEERR
L.251: AOS AC1,STKP ; AC1,STKP
MOVEM AC11,PCSTAK(AC1) ; OPAV,PCSTAK(AC1)
JRST L.179 ; L.179
L.252: MOVE AC1,STKP ; AC1,STKP
MOVE AC11,PCSTAK(AC1) ; OPAV,PCSTAK(AC1)
SOS STKP ; STKP
L.253: HRRZ AC1,INSTR ; AC1,INSTR
CAIE AC1,-100000 ; AC1,-100000
JRST L.179 ; L.179
MOVE AC1,AC11 ; AC1,OPAV
L.254: PUSHJ SP,PCEFST ; SP,PCEFST
JRST L.179 ; L.179
L.255: PUSHJ SP,DPRMPT ; SP,DPRMPT
JRST L.179 ; L.179
L.256: SETO AC13, ; HALTCD,
L.257: MOVE AC1,PCCURC ; AC1,PCCURC
LDB AC2,C.37 ; AC2,[POINT 1,12(AC1),5] <30,1>
JUMPE AC2,L.259 ; AC2,L.259
MOVEI AC1,CFM_FLDDB ; AC1,CFM_FLDDB
SETZ AC2, ; AC2,
PUSHJ SP,PCIPRS ; SP,PCIPRS
JUMPGE AC1,L.258 ; AC1,L.258
SETZ AC1, ; AC1,
PUSHJ SP,PCMPER ; SP,PCMPER
L.258: MOVE AC1,PCCURC ; AC1,PCCURC
MOVSI AC2,10000 ; AC2,10000
ANDCAM AC2,12(AC1) ; AC2,12(AC1)
L.259: MOVE AC10,AC14 ; AC10,ECB
ADDI AC10,3 ; AC10,3
JUMPGE AC13,L.264 ; HALTCD,L.264
CAMN AC13,C.41 ; HALTCD,[-2]
JRST L.260 ; L.260
CAME AC13,C.56 ; HALTCD,[-3]
JRST L.261 ; L.261
L.260: HLRZ AC1,10(AC14) ; AC1,10(ECB)
MOVEM AC1,FORK ; AC1,FORK
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,PCFORK ; AC1,PCFORK
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,PCRNFK ; AC1,PCRNFK
MOVE AC1,FORK ; AC1,FORK
PUSHJ SP,CLRINV ; SP,CLRINV
L.261: CAME AC13,C.36 ; HALTCD,[-1]
JRST L.262 ; L.262
SETO AC1, ; AC1,
JRST L.263 ; L.263
L.262: SETZ AC1, ; AC1,
L.263: PUSHJ SP,PCICLP ; SP,PCICLP
PUSHJ SP,CLNVAR ; SP,CLNVAR
HLRZ AC1,0(AC10) ; AC1,0(AC10)
SUBI AC1,1 ; AC1,1
MOVEM AC1,STKP ; AC1,STKP
JRST L.265 ; L.265
L.264: MOVE AC1,CURGST ; AC1,CURGST
HRLM AC1,0(AC14) ; AC1,0(ECB)
MOVE AC1,PC ; AC1,PC
HRRM AC1,2(AC14) ; AC1,2(ECB)
MOVE AC1,FP ; AC1,FP
HRLM AC1,2(AC14) ; AC1,2(ECB)
MOVE AC1,STKP ; AC1,STKP
HRRM AC1,0(AC10) ; AC1,0(AC10)
L.265: MOVE AC1,AC13 ; AC1,HALTCD
L.266: 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.46: POINT 8,0(AC2),17 ; 8,0(GST),17
C.47: POINT 3,INSTR,2 ; 3,INSTR,2
C.48: CMPSLE ;
EXP 0 ; 0
EXP 0 ; 0
C.49: CMPSL ;
EXP 0 ; 0
EXP 0 ; 0
C.50: CMPSE ;
EXP 0 ; 0
EXP 0 ; 0
C.51: CMPSN ;
EXP 0 ; 0
EXP 0 ; 0
C.52: CMPSGE ;
EXP 0 ; 0
EXP 0 ; 0
C.53: CMPSG ;
EXP 0 ; 0
EXP 0 ; 0
C.54: EXP PCSTAK+2 ; PCSTAK+2
C.55: EXP <PCSTKL*1000> ; <PCSTKL*1000>
C.56: EXP -3 ; -3
; Routine Size: 514 words
; 2279 END
; 2280 ELUDOM
END
; Low segment length: 0 words
; High segment length: 2281 words
; LIBRARY STATISTICS
;
; -------- Symbols -------- Blocks
; File Total Loaded Percent Read
;
; PK:<PA0B>EXECPD.L36.9 306 184 60 0
; PS:<BLISS>TENDEF.L36.5 56 5 8 0
; PS:<BLISS>MONSYM.L36.10 4077 34 0 0
; Information: 1
; Warnings: 3
; Errors: 0
; Compilation Complete
END