Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/execpi.lst
There are no other files named execpi.lst in the archive.
;712 CMU PCL 5(100) release version
; 0001 !<5.1.EXEC>EXECPI.B36.6, 16-Nov-82 05:02:39, Edit by PA0B
; 0002 !Fix TYPEIN not to raise lowercase (clear TT%LIC for PTY
; 0003 !in REDFRK), Rewrite PCIKIF to not hang in RELD%.
; 0004 !Note: PCICLP should be rewritten so that it doesn't do
; 0005 !most of the thing that PCIKIF does and then call PCIKIF
; 0006 !to do them again...
; 0007 !<5.1.EXEC>EXECPI.B36.5, 15-Nov-82 02:38:51, Edit by PA0B
; 0008 !Make file parses fail if WILD not specified but wildcards
; 0009 !specified anyway, Allow DISPLAY'ing of integers, Make
; 0010 !global variable declarations always do something (previously
; 0011 !they were ignored (unless the declaration was in an .ENV file)
; 0012 !if another PCL object with the same name as the variable
; 0013 !already existed, Move PCIRUN to EXECPX, Initialize PCLSTF
; 0014 !to -1 instead of to PCEOWN.
; 0015 !<5.1.EXEC>EXECPI.B36.4, 2-Nov-82 08:05:44, Edit by PA0B
; 0016 !More of previous change: add FK%INV fork flag to keep track
; 0017 !of which forks are INVOKE'd, Change most things which look
; 0018 !at FORK to look at PCCURC[ECB_CFK], Fix PCIINF to tolerate
; 0019 !garbage from .MORLW MTOPR% on an ITY, Fix UNPKEY to sign-extend
; 0020 !the data value (makes negative values for WORDS work; fix
; 0021 !courtesy of Charlie Kim at Columbia).
; 0022 !<5.1.EXEC>EXECPI.B36.3, 4-Aug-82 22:53:31, Edit by PA0B
; 0023 !Change code which saves/restores FORK to save it only during
; 0024 !execution of INVOKE and TYPEIN statements (and to restore it
; 0025 !immediately afterwards. Also save RUNFK.
; 0026 !<5.1.EXEC>EXECPI.B36.2, 30-May-82 15:40:34, Edit by PA0B
; 0027 !Don't handle PTY's and PDS's differently in REDFRK, so that
; 0028 !(hopefully) users of GETTYPEOUT won't have to know which we
; 0029 !are using, Do RELD% after SCTTY% in PCICLP (under v5.1,
; 0030 !RELD% hangs if done on a tty which is some fork's controlling
; 0031 !tty)
; 0032 !<4.EXEC>EXECPI.B36.103, 7-Mar-82 23:58:38, Edit by PA0B
; 0033 !Make it so that in the normal case (ie, the PCL command
; 0034 !does no explicit "Reset" commands and no EXIT TOPROGRAM
; 0035 !or EXIT SAVE is done) a PCL which does an INVOKE saves
; 0036 !and restores FORK. This makes it invisible to the user
; 0037 !whether a particular PCL does an INVOKE. Make INIIVK
; 0038 !zero STAYF so that we wait for the INVOKE'd fork to halt
; 0039 !or become hungry even if the last thing we did was to run
; 0040 !something in the background. Correct foldcasing code in
; 0041 !PCIDGS (didn't work if name contained digits).
; 0042 !<4.EXEC>EXECPI.B36.102, 23-Jun-81 14:28:08, Edit by DK32
; 0043 !New environment file code number
; 0044 !<4.EXEC>EXECPI.B36.101, 29-Apr-81 16:52:44, Edit by DK32
; 0045 !Use correct ECB in PCIPSO for DoCommand To output
; 0046 !<4.EXEC>EXECPI.B36.100, 6-Apr-81 11:05:14, Edit by DK32
; 0047 !Use correct value from PCIFGS
; 0048 !<4.EXEC>EXECPI.B36.99, 24-Mar-81 20:03:02, Edit by DK32
; 0049 !Type the correct part of the buffer in Passoutput mode
; 0050 !<4.EXEC>EXECPI.B36.98, 14-Mar-81 13:10:10, Edit by DK32
; 0051 !More ECB initialization
; 0052 !<4.EXEC>EXECPI.B36.97, 7-Mar-81 18:02:24, Edit by DK32
; 0053 !Note whether parsing in progress
; 0054 !<4.EXEC>EXECPI.B36.96, 25-Feb-81 21:52:25, Edit by DK32
; 0055 !Prompt, Redo symbol replacement, Remove hack for bug
; 0056 !in old Bliss, PassOutput
; 0057 !<4.EXEC>EXECPI.B36.95, 7-Jan-81 21:33:16, Edit by DK32
; 0058 !Close PTY when you kill a fork, Don't kill controlled
; 0059 !forks which were not Invoked, Make Invoke kill any
; 0060 !previously Invoked fork, Fix Info PCL line width
; 0061 !<4.EXEC>EXECPI.B36.94, 22-Dec-80 17:53:51, Edit by DK32
; 0062 !Use Exec linkage
; 0063 !<4.EXEC>EXECPI.B36.93, 11-Dec-80 23:54:50, Edit by DK32
; 0064 !Make preserved context possible
; 0065 !<4.EXEC>EXECPI.B36.92, 9-Dec-80 21:02:36, Edit by DK32
; 0066 !Grab hold of current fork if Typein given without Invoke,
; 0067 !Fix case folding in Set Variable, Option to cleanup not
; 0068 !to kill fork, Change meaning of PCLGST, Fix Info PCL of
; 0069 !Undeclare Original
; 0070 !<4.EXEC>EXECPI.B36.91, 4-Dec-80 15:25:08, Edit by DK32
; 0071 !Keep command GST in ECB
; 0072 !<4.EXEC>EXECPI.B36.90, 30-Nov-80 00:35:38, Edit by DK32
; 0073 !Change some indenting, Save/Exec
; 0074 !<4.EXEC>EXECPI.B36.89, 11-Nov-80 23:35:14, Edit by DK32
; 0075 !Change variable handling in environments so common
; 0076 !subexpression optimization doesn't compile incorrectly,
; 0077 !Give more detail for synonyms in Info PCL, Handle running
; 0078 !out of memory in PDS PSI
; 0079 !<4.EXEC>EXECPI.B36.88, 31-Oct-80 14:40:44, Edit by DK32
; 0080 !<4.EXEC>EXECPI.B36.87, 29-Oct-80 16:11:27, Edit by DK32
; 0081 !No initial space from Information Variable, Runtime
; 0082 !channel list
; 0083 !<4.EXEC>EXECPI.B36.86, 25-Oct-80 23:02:21, Edit by DK32
; 0084 !Keep invoked fork in ECB and kill it at cleanup
; 0085 !<4.EXEC>EXECPI.B36.85, 21-Oct-80 21:58:24, Edit by DK32
; 0086 !Initialize text area better, Remove Procdefs, Save
; 0087 !variable values in environments
; 0088 !<4.EXEC>EXECPI.B36.84, 18-Oct-80 15:53:42, Edit by DK32
; 0089 !Parse List, Fix Info PCL width code, Unstack parsed JFNs
; 0090 !<4.EXEC>EXECPI.B36.83, 9-Oct-80 21:29:05, Edit by DK32
; 0091 !Make parsed JFN list, Don't do reset in Invoke, Observe
; 0092 !terminal widths in Information PCL
; 0093 !<4.EXEC>EXECPI.B36.82, 2-Oct-80 15:45:05, Edit by DK32
; 0094 !Fix Info Variable of empty string variable, Use text
; 0095 !area for global symbol name strings and values, Add
; 0096 !Parse NoIndirect
; 0097 !<4.EXEC>EXECPI.B36.81, 25-Sep-80 21:52:48, Edit by DK32
; 0098 !Remove SCTTY fudge, Initialize and cleanup runtime I/O
; 0099 !<4.EXEC>EXECPI.B36.80, 10-Sep-80 14:14:52, Edit by DK32
; 0100 !Use PCMWTF instead of WAITA, Halt fork before SCTTY,
; 0101 !Allocate GST only from top, Define null synonyms, New
; 0102 !Information PCL format, Raise input in PCIDFV, Get all
; 0103 !output out of control line for each PDS PSI
; 0104 !<4.EXEC>EXECPI.B36.79, 7-Sep-80 22:19:53, Edit by DK32
; 0105 !Change PCT to PDS, SIN doesn't give extra null, Initialize
; 0106 !ECB with no output designator
; 0107 !<DK32.CG>EXECPI.B36.78, 11-Aug-80 16:12:22, Edit by DK32
; 0108 !Try to eliminate "Device or data error" on PTY close
; 0109 !<DK32.CG>EXECPI.B36.77, 8-Aug-80 17:35:58, Edit by DK32
; 0110 !Keep PCT details in ECB, Parse Number fills $Atom also
; 0111 !<DK32.CG>EXECPI.B36.76, 5-Aug-80 17:43:19, Edit by DK32
; 0112 !Use PCT's on Variant 1
; 0113 !<DK32.CG>EXECPI.B36.75, 1-Aug-80 15:09:35, Edit by DK32
; 0114 !Fix IOX33 in Typein, Set PTY modes to match real terminal
; 0115 !<DK32.CG>EXECPI.B36.74, 31-Jul-80 15:22:54, Edit by DK32
; 0116 !Change PCIKIL to PCICFK to simply disconnect fork from PTY,
; 0117 !New ENVIR_NUM, Run PTY in full duplex with echoing, Fix Declare errors
; 0118 !<DK32.CG>EXECPI.B36.73, 19-Jul-80 19:20:07, Edit by DK32
; 0119 !Synonyms always have a spare word before their name blocks, in case
; 0120 !they need be abbreviations. Add additional argument to PCMDFO call.
; 0121 !<DK32.CG>EXECPI.B36.72, 18-Jul-80 14:46:30, Edit by DK32
; 0122 !Change name of PCIDEV
; 0123 !<DK32.CG>EXECPI.B36.71, 17-Jul-80 13:22:27, Edit by DK32
; 0124 !Initialize ECB_DCB
; 0125 !<DK32.CG>EXECPI.B36.70, 10-Jul-80 10:34:45, Edit by DK32
; 0126 !Environment files have format number in first word
; 0127 !<DK32.CG>EXECPI.B36.69, 2-Jul-80 14:02:05, Edit by DK32
; 0128 !$FILES has device and directory if not default
; 0129
; 0130 MODULE EXECPI =
; 0131 BEGIN
; 0132
; 0133 !++
; 0134 !
; 0135 ! This is the first attempt at the Programmable Command Language interface
; 0136 !
; 0137 ! Dave King, Carnegie-Mellon University Computation Center
; 0138 !
; 0139 ! January, 1980
; 0140 !
; 0141 ! Copyright (C) 1980, Carnegie-Mellon University
; 0142 !
; 0143 !--
; 0144
; 0145 !++
; 0146 ! This module contains the routines which stand in between the standard
; 0147 ! Exec and the internals of PCL. That, at least, was the original reason
; 0148 ! for this module; it has since become apparent that there is not as much
; 0149 ! need for separation as I once felt. In this module are routines called
; 0150 ! from MACRO code to perform PCL functions, and from inner levels of PCL
; 0151 ! to provide system services.
; 0152 !--
; 0153
; 0154 !
; 0155 ! Standard definitions
; 0156 !
; 0157
; 0158 LIBRARY 'EXECPD';
; 0159 LIBRARY 'BLI:TENDEF';
; 0160 LIBRARY 'BLI:MONSYM';
; WARN#050 ........1 L1:0160
; Name already declared in this block: $CHLFD
; WARN#050 ........1 L1:0160
; Name already declared in this block: $CHCRT
; WARN#050 ........1 L1:0160
; Name already declared in this block: $CHFFD
; 0161 SWITCHES LINKAGE(EXEC);
; 0162
; 0163 BUILTIN JSYS,MACHSKIP;
; 0164
; 0165 !
; 0166 ! Table of contents:
; 0167 !
; 0168
; 0169 FORWARD ROUTINE
; 0170 PCINIT: NOVALUE, ! Initialize PCL system
; 0171 PCIFGS, ! Find global symbol
; 0172 PCICGS: NOVALUE, ! Create global symbol table entry
; 0173 PCIDFV: NOVALUE, ! Entry point for DECLARE Integer and String
; 0174 PCIDFS: NOVALUE, ! Entry point for Synonym definition
; 0175 PCIWEV: NOVALUE, ! Entry point for WRITE Environment
; 0176 PCIGEV: NOVALUE, ! Entry point for DECLARE Environment
; 0177 PCIPSV: NOVALUE, ! Mark all symbols as preserved
; 0178 PCIUDF, ! Entry point for UNDECLARE
; 0179 FREESTG: NOVALUE, ! Free memory related to global symbol
; 0180 PCIINF, ! Entry point for INFORMATION PCL-OBJECTS
; 0181 PCISGS, ! Entry point for SET VARIABLE
; 0182 PCIDGS, ! Entry point for INFORMATION VARIABLE
; 0183 ! PCIRUN, ! Entry point for command invocation
; 0184 PCIPRS, ! Do Parse
; 0185 UNPFIL, ! Save parsed JFN
; 0186 UNPUNM: NOVALUE, ! Unparse parsed directory/user name
; 0187 UNPTAD: NOVALUE, ! Unparse parsed date-time
; 0188 UNPKEY: NOVALUE, ! Unparse keyword/switch
; 0189 UNPATM: NOVALUE, ! Copy atom buffer
; 0190 PRSFLS, ! Do Parse of File List
; 0191 PCIIVK: NOVALUE, ! Invoke user program
; 0192 INIIVK: NOVALUE, ! Initialize fork for Invoke
; 0193 FNDCTY: NOVALUE, ! Get a PDS for PCL
; 0194 REDFRK: NOVALUE, ! Ready fork
; 0195 PCICLP: NOVALUE, ! Clean up all JFN's and forks
; 0196 PCIKIF: NOVALUE, ! Kill invoked fork
; 0197 PCIRPL: NOVALUE, ! Release Parse JFN list
; 0198 PCITIN: NOVALUE, ! Type in to user program
; 0199 WTFPGM, ! Wait for program to require PCL
; 0200 PCIPEO: NOVALUE, ! Prepare for Exec output
; 0201 PCIPSO: NOVALUE, ! Handle PTY-output pseudointerrupt
; 0202 PCIDPY: NOVALUE; ! Display string on real terminal
; 0203
; 0204 !
; 0205 ! Macros:
; 0206 !
; 0207
; 0208 MACRO ERROR(TXT) = PCMXER(UPLIT(%ASCIZ TXT)) %;
; 0209
; 0210 !
; 0211 ! External references:
; 0212 !
; 0213
; 0214 EXTERNAL ROUTINE
; 0215 PCCCPL, ! The compiler
; 0216 PCEXCT: NOVALUE, ! The executer
; 0217 PCMDFO, ! Define object to regular Exec
; 0218 PCMUDF: NOVALUE, ! Undefine object in regular Exec
; 0219 PCMRKT: NOVALUE, ! Require command keyword table size
; 0220 ! PCPRUN: NOVALUE, ! The Procdef execution initializer
; 0221 PCMPRS, ! Macro-interface Parse routine
; 0222 SETINV: NOVALUE, ! Set FK%INV in fork table
; 0223 PCMGJS, ! Get and stack a JFN
; 0224 PCMITS, ! CVTBDO routine
; 0225 ECFORK: NOVALUE, ! EXECP routine to create fork
; 0226 KEFORK: NOVALUE, ! EXECP routine to kill fork
; 0227 DOGET, ! Support routine to GET%
; 0228 JUNSTK, ! EXECSU Unstack top JFN on JFN stack
; 0229 PCMSPN: NOVALUE, ! Set program name
; 0230 PCMWTF, ! Resume program and wait for it to finish
; 0231 GTBUFX, ! EXECSU Permanent memory allocate
; 0232 PCMGMM, ! General memory allocate
; 0233 PCMGME, ! General memory allocate with error
; 0234 RETMEM: NOVALUE, ! EXECSU Memory release
; 0235 SUBBP, ! EXECSU Subtract two byte pointers
; 0236 LM: NOVALUE, ! EXECSU Get cursor to left margin
; 0237 DINCLS: NOVALUE, ! EXECPU Close runtime files
; 0238 PCMSTI, ! CVTDBO routine
; 0239 PCMXER, ! Execution error
; 0240 PCMCER; ! Compilation error
; 0241
; 0242 EXTERNAL
; 0243 PCTEXT: VECTOR, ! Pure text region
; 0244 PCTXFR, ! Pure text free list
; 0245 PCGBST: GST_TBL, ! Global symbol table
; 0246 PCLSTF, ! First unused word of run stack
; 0247 PCLGST, ! Index of next entry to allocate in GST
; 0248 PCCURC: REF ECB_BLK, ! Current Execution Context Block
; 0249 %( these should be ecb-specific )%
; 0250 PCPOTP: VOLATILE, ! Address of block of user program output
; 0251 PCPEOP: VOLATILE, ! Address of block of Exec output
; 0252 PCPRGR, ! Flag to indicate controlled program running
; 0253 PCVVAL, ! System variable VALUE
; 0254 PCVATM: STR_VAL, ! System variable ATOM
; 0255 ATMBUF: VECTOR, ! Common COMND% atom buffer
; 0256 CSBUFP, ! Common string buffer pointer
; 0257 FORK, ! Common user fork handle
; 0258 RUNFK, ! Fork handle of running fork
; 0259 COJFN, ! Preferred output JFN
; 0260 XDICT, ! Permanent storage pool
; 0261 STAYF, ! Flag which indicates whether to stay at
; 0262 ! command level when program is run
; 0263 PCFORK, ! Saved value of FORK
; 0264 PCRNFK; ! Saved value of RUNFK
; 0265
; 0266 EXTERNAL LITERAL
; 0267 PCTXLN: UNSIGNED(3), ! Length of text area
; 0268 PCGBLN: UNSIGNED(3), ! Length of global symbol table
; 0269 PCLCHI: UNSIGNED(6), ! PTY input PSI channel
; 0270 PCLCHO: UNSIGNED(6), ! PTY output PSI channel
; 0271 PCEOWN: UNSIGNED(6); ! Number of Executer permanent variables
; 0272
; 0273 !
; 0274 ! Equated symbols:
; 0275 !
; 0276
; 0277 LITERAL
; 0278 ENVIR_NUM = %O'123456000004'; ! Environment file format number
; 0279
; 0280 BIND
; 0281 GBSTLN=PCGBLN*512/GST_LEN; ! Maximum GST index possible
; 0282
; 0283 GLOBAL ROUTINE PCINIT: NOVALUE = ! Initialize PCL system
; 0284
; 0285 !++
; 0286 ! Functional description:
; 0287 ! Called from EXECPM on first use of PCL. Initializes static
; 0288 ! tables to be filled in by the rest of system, enables SC%SCT.
; 0289 !
; 0290 ! Formal parameters:
; 0291 ! None
; 0292 !
; 0293 ! Implicit inputs:
; 0294 ! None
; 0295 !
; 0296 ! Implicit outputs:
; 0297 ! Text free list, runtime String Space free list, privileges
; 0298 !
; 0299 ! Routine value:
; 0300 ! None
; 0301 !
; 0302 ! Side effects:
; 0303 ! None
; 0304 !--
; 0305
; 0306 BEGIN
; 0307 MAP
; 0308 PCTEXT: FRE_LST;
; 0309 REGISTER R1=1,R2=2,R3=3;
; 0310 IF .PCTXFR EQL 0
; 0311 THEN
; 0312 BEGIN
; 0313 PCTXFR = PCTEXT;
; 0314 PCTEXT[FRE_CNT] = PCTXLN*512;
; 0315 PCTEXT[FRE_PTR] = 0
; 0316 END;
; 0317 PCLSTF = -1;
; 0318 R1 = $FHSLF;
; 0319 JSYS(0,RPCAP,R1,R2,R3);
; 0320 POINTR(R3,SC_SCT) = 1;
; 0321 JSYS(0,EPCAP,R1,R2,R3);
; 0322 PCFORK = -2;
; 0323 PCRNFK = -2;
; 0324 END;
TITLE EXECPI
TWOSEG
.REQUEST SYS:B362LB.REL
EXTERN PCCCPL, PCEXCT, PCMDFO, PCMUDF, PCMRKT, PCMPRS, SETINV, PCMGJS, PCMITS, ECFORK, KEFORK
EXTERN DOGET, JUNSTK, PCMSPN, PCMWTF, GTBUFX, PCMGMM, PCMGME, RETMEM, SUBBP, LM, DINCLS, PCMSTI
EXTERN PCMXER, PCMCER, PCTEXT, PCTXFR, PCGBST, PCLSTF, PCLGST, PCCURC, PCPOTP, PCPEOP, PCPRGR
EXTERN PCVVAL, PCVATM, ATMBUF, CSBUFP, FORK, RUNFK, COJFN, XDICT, STAYF, PCFORK, PCRNFK, PCTXLN
EXTERN PCGBLN, PCLCHI, PCLCHO, PCEOWN
GBSTLN= <<PCGBLN*1000>/3>
AC0= 0
AC1= 1
AC2= 2
AC3= 3
AC4= 4
AC5= 5
AC6= 6
AC7= 7
AC10= 10
AC11= 11
AC12= 12
AC13= 13
AC14= 14
FP= 15
AC16= 16
SP= 17
RELOC 400000
PCINIT::SKIPE PCTXFR ; PCTXFR
JRST L.1 ; L.1
MOVEI AC1,PCTEXT ; AC1,PCTEXT
MOVEM AC1,PCTXFR ; AC1,PCTXFR
MOVE AC1,C.1 ; AC1,[<PCTXLN*1000>]
HRLM AC1,PCTEXT ; AC1,PCTEXT
HLLZS PCTEXT ; PCTEXT
L.1: SETOM PCLSTF ; PCLSTF
MOVEI AC1,400000 ; R1,400000
JSYS 150 ; 150
TLO AC3,4000 ; R3,4000
JSYS 151 ; 151
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,PCFORK ; AC1,PCFORK
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,PCRNFK ; AC1,PCRNFK
POPJ SP, ; SP,
C.1: EXP <PCTXLN*1000> ; <PCTXLN*1000>
; Routine Size: 18 words
; 0325
; 0326 GLOBAL ROUTINE PCIFGS(
; 0327 NAMSTR, ! Stringvalue of desired name
; 0328 PSVFLG ! Nonzero if preserved entry required
; 0329 ) = ! Find global symbol
; 0330
; 0331 !++
; 0332 ! Functional description:
; 0333 ! Locates Global Symbol Table entry for given name, and
; 0334 ! returns its address.
; 0335 !
; 0336 ! Formal parameters:
; 0337 ! Stringvalue of desired name
; 0338 ! Nonzero if preserved entry required
; 0339 !
; 0340 ! Implicit inputs:
; 0341 ! Global Symbol Table
; 0342 !
; 0343 ! Implicit outputs:
; 0344 ! None
; 0345 !
; 0346 ! Routine value:
; 0347 ! Global Symbol Table entry address, or -1 if not found
; 0348 !
; 0349 ! Side effects:
; 0350 ! None
; 0351 !
; 0352 !--
; 0353
; 0354 BEGIN
; 0355 MAP
; 0356 NAMSTR: STR_VAL;
; 0357 DECR I FROM .PCLGST-1 DO
; 0358 IF .PCGBST[.I,GST_VLD] NEQ 0 THEN
; 0359 IF .NAMSTR[STV_LEN] EQL .PCGBST[.I,GST_NML] THEN
; 0360 IF CH$EQL( .NAMSTR[STV_LEN], BYTPTR(.NAMSTR[STV_ADR]),
; 0361 .NAMSTR[STV_LEN], BYTPTR(.PCGBST[.I,GST_NMA]))
; 0362 THEN
; 0363 IF .PSVFLG EQL 0 OR .PCGBST[.I,GST_PSV]
; 0364 THEN
; 0365 RETURN PCGBST[.I,GST_VLD]
; 0366 END;
PCIFGS::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC13,AC2 ; PSVFLG,AC2
MOVE AC16,AC1 ; NAMSTR,AC1
MOVE AC14,PCLGST ; I,PCLGST
JRST L.4 ; L.4
L.2: MOVE AC3,AC14 ; AC3,I
IMULI AC3,3 ; AC3,3
SKIPN PCGBST(AC3) ; PCGBST(AC3)
JRST L.4 ; L.4
HLRZ AC1,AC16 ; AC1,NAMSTR
HLRZ AC2,PCGBST+2(AC3) ; AC2,PCGBST+2(AC3)
CAME AC1,AC2 ; AC1,AC2
JRST L.4 ; L.4
MOVEI AC2,0(AC16) ; HLF,0(NAMSTR)
HRLI AC2,-337100 ; HLF,-337100
HRRZ AC5,PCGBST+2(AC3) ; HLF,PCGBST+2(AC3)
HRLI AC5,-337100 ; HLF,-337100
HLRZ AC1,AC16 ; AC1,NAMSTR
HLRZ AC4,AC16 ; AC4,NAMSTR
EXTEND AC1,C.2 ; AC1,[CMPSE ]
JRST L.4 ; L.4
JUMPE AC13,L.3 ; PSVFLG,L.3
SKIPL PCGBST(AC3) ; PCGBST(AC3)
JRST L.4 ; L.4
L.3: MOVEI AC1,PCGBST(AC3) ; AC1,PCGBST(AC3)
JRST L.5 ; L.5
L.4: SOJGE AC14,L.2 ; I,L.2
SETO AC1, ; AC1,
L.5: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.2: CMPSE ;
; Routine Size: 33 words
; 0367
; 0368 GLOBAL ROUTINE PCICGS(GS): NOVALUE = ! Create global symbol table entry
; 0369
; 0370 !++
; 0371 ! Functional description:
; 0372 ! Given complete description of new global object, creates entry
; 0373 ! for it in global symbol table, and calls Exec to define it
; 0374 ! in its own tables and to confirm the definition to the user.
; 0375 ! If the name is not unique, the old one is replaced.
; 0376 !
; 0377 ! Formal parameters:
; 0378 ! Address of GST block containing the vital information;
; 0379 ! the GST_NAM field contains the real pointer to be used.
; 0380 !
; 0381 ! Implicit inputs:
; 0382 ! None
; 0383 !
; 0384 ! Implicit outputs:
; 0385 ! Global symbol table
; 0386 !
; 0387 ! Routine value:
; 0388 ! None
; 0389 !
; 0390 ! Side effects:
; 0391 ! None
; 0392 !
; 0393 !--
; 0394
; 0395 BEGIN
; 0396 EXTERNAL REGISTER Z=0;
; 0397 LOCAL
; 0398 GST: REF GST_BLK,
; 0399 DPL;
; 0400 MAP
; 0401 GS: REF BLOCK[GST_LEN] FIELD (GST_FLD);
; 0402 DPL = 0;
; 0403 GST = PCIFGS(.GS[GST_NAM],0);
; 0404 IF .GST GTR 0
; 0405 THEN
; 0406 BEGIN
; 0407 DPL = -1;
; 0408 IF .GST[GST_PSV] THEN GST = 0
; 0409 END;
; 0410 IF .GST LEQ 0
; 0411 THEN
; 0412 BEGIN
; 0413 IF .PCLGST GEQ GBSTLN
; 0414 THEN
; 0415 PCMCER(UPLIT(%ASCIZ'Global symbol table full'));
; 0416 GST = PCGBST[.PCLGST,GST_VLD];
; 0417 PCLGST = .PCLGST + 1
; 0418 END
; 0419 ELSE
; 0420 FREESTG(.GST);
; 0421 GST[GST_VLD] = .GS[GST_VLD];
; 0422 GST[GST_VAL] = .GS[GST_VAL];
; 0423 GST[GST_NAM] = .GS[GST_NAM];
; 0424 GST[GST_DPL] = .DPL;
; 0425 PCMDFO(.GS[GST_CLS], .GS[GST_NMA], .DPL, .GS[GST_TXT])
; 0426 END;
P.AAA: BYTE (7)"G","l","o","b","a" ; Globa
BYTE (7)"l"," ","s","y","m" ; l sym
BYTE (7)"b","o","l"," ","t" ; bol t
BYTE (7)"a","b","l","e"," " ; able
BYTE (7)"f","u","l","l",000 ; full
PCICGS::PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC1 ; GS,AC1
SETZ AC12, ; DPL,
MOVE AC1,2(AC14) ; AC1,2(GS)
SETZ AC2, ; AC2,
PUSHJ SP,PCIFGS ; SP,PCIFGS
MOVE AC13,AC1 ; GST,AC1
JUMPLE AC13,L.6 ; GST,L.6
SETO AC12, ; DPL,
SKIPGE 0(AC13) ; 0(GST)
SETZ AC13, ; GST,
L.6: JUMPG AC13,L.8 ; GST,L.8
MOVE AC1,PCLGST ; AC1,PCLGST
CAMGE AC1,C.5 ; AC1,[<<PCGBLN*1000>/3>]
JRST L.7 ; L.7
MOVEI AC1,P.AAA ; AC1,P.AAA
PUSHJ SP,PCMCER ; SP,PCMCER
L.7: MOVE AC1,PCLGST ; AC1,PCLGST
IMULI AC1,3 ; AC1,3
MOVE AC13,AC1 ; GST,AC1
ADDI AC13,PCGBST ; GST,PCGBST
AOS PCLGST ; PCLGST
JRST L.9 ; L.9
L.8: MOVE AC1,AC13 ; AC1,GST
PUSHJ SP,FREESTG ; SP,FREESTG
L.9: MOVE AC1,0(AC14) ; AC1,0(GS)
MOVEM AC1,0(AC13) ; AC1,0(GST)
MOVE AC1,1(AC14) ; AC1,1(GS)
MOVEM AC1,1(AC13) ; AC1,1(GST)
MOVE AC1,2(AC14) ; AC1,2(GS)
MOVEM AC1,2(AC13) ; AC1,2(GST)
DPB AC12,C.3 ; DPL,[POINT 1,0(GST),1] <34,1>
LDB AC1,C.4 ; AC1,[POINT 3,0(GS),4] <31,3>
HRRZ AC2,2(AC14) ; AC2,2(GS)
MOVE AC3,AC12 ; AC3,DPL
HRRZ AC4,0(AC14) ; AC4,0(GS)
PUSHJ SP,PCMDFO ; SP,PCMDFO
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.3: POINT 1,0(AC13),1 ; 1,0(GST),1
C.4: POINT 3,0(AC14),4 ; 3,0(GS),4
C.5: EXP <<PCGBLN*1000>/3> ; <<PCGBLN*1000>/3>
; Routine Size: 46 words
; 0427
; 0428 GLOBAL ROUTINE PCIDFV(VARNAM,VARTYP): NOVALUE = ! Define variable
; 0429
; 0430 !++
; 0431 ! Functional description:
; 0432 ! Called from EXECPM to perform DECLARE I or S command. Defines global
; 0433 ! variable with given name (case folded) and type and no value.
; 0434 !
; 0435 ! Formal parameters:
; 0436 ! Stringvalue of name of variable (not case folded)
; 0437 ! 0 for integer, -1 for string
; 0438 !
; 0439 ! Implicit inputs:
; 0440 ! Global symbol table
; 0441 !
; 0442 ! Implicit outputs:
; 0443 ! Global symbol table, permanent storage pool
; 0444 !
; 0445 ! Routine value:
; 0446 ! None
; 0447 !
; 0448 ! Side effects:
; 0449 ! None
; 0450 !
; 0451 !--
; 0452
; 0453 BEGIN
; 0454 EXTERNAL REGISTER Z=0;
; 0455 LOCAL
; 0456 IPT, ! String pointers
; 0457 OPT,
; 0458 CHR, ! Character
; 0459 GS: BLOCK[GST_LEN] FIELD(GST_FLD); ! A global symbol entry
; 0460 MAP
; 0461 VARNAM: STR_VAL;
; 0462 IPT = BYTPTR(.VARNAM[STV_ADR]);
; 0463 OPT = .IPT;
; 0464 DECR I FROM .VARNAM[STV_LEN] DO
; 0465 BEGIN
; 0466 CHR = CH$RCHAR_A(IPT);
; 0467 IF .CHR GEQ %C'a' AND .CHR LEQ %C'z' THEN CHR = .CHR - %C'a' + %C'A';
; 0468 CH$WCHAR_A(.CHR,OPT)
; 0469 END;
; 0470 ! IF PCIFGS(.VARNAM,0) GTR 0 THEN RETURN;
; 0471 GS[GST_CLS] = GST_CLS_VAR;
; 0472 GS[GST_TYP] = (IF .VARTYP EQL 0 THEN GST_TYP_INT ELSE GST_TYP_STR);
; 0473 GS[GST_VAL] = 0;
; 0474 GS[GST_NML] = .VARNAM[STV_LEN];
; 0475 GS[GST_NMA] = PCMGMM((.VARNAM[STV_LEN]+5)/5, PCTXFR);
; 0476 CH$MOVE(.VARNAM[STV_LEN],BYTPTR(.VARNAM[STV_ADR]),BYTPTR(.GS[GST_NAM]));
; 0477 CH$WCHAR($CHNUL,CH$PTR(.GS[GST_NAM],.VARNAM[STV_LEN]));
; 0478 PCICGS(GS)
; 0479 END;
PCIDFV::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,3 ; SP,3
MOVE AC13,AC1 ; VARNAM,AC1
MOVEI AC1,0(AC13) ; HLF,0(VARNAM)
HRLI AC1,-337100 ; HLF,-337100
MOVE AC3,AC1 ; IPT,HLF
MOVE AC5,AC3 ; OPT,IPT
HLRZ AC4,AC13 ; I,VARNAM
AOJA AC4,L.12 ; I,L.12
L.10: ILDB AC1,AC3 ; CHR,IPT
CAIL AC1,141 ; CHR,141
CAILE AC1,172 ; CHR,172
JRST L.11 ; L.11
SUBI AC1,40 ; CHR,40
L.11: IDPB AC1,AC5 ; CHR,OPT
L.12: SOJGE AC4,L.10 ; I,L.10
MOVEI AC1,2 ; AC1,2
DPB AC1,C.6 ; AC1,[POINT 3,GS,4] <31,3>
JUMPN AC2,L.13 ; VARTYP,L.13
TDZA AC1,AC1 ; AC1,AC1
L.13: MOVEI AC1,1 ; AC1,1
DPB AC1,C.7 ; AC1,[POINT 1,GS,5] <30,1>
SETZM -1(SP) ; GS+1
HLRZ AC14,AC13 ; AC14,VARNAM
HRLM AC14,0(SP) ; AC14,GS+2
MOVE AC1,AC14 ; AC1,AC14
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,PCTXFR ; AC2,PCTXFR
PUSHJ SP,PCMGMM ; SP,PCMGMM
HRRM AC1,0(SP) ; AC1,GS+2
MOVEI AC2,0(AC13) ; HLF,0(VARNAM)
HRLI AC2,-337100 ; HLF,-337100
MOVE AC3,0(SP) ; AC3,GS+2
MOVE AC5,AC3 ; HLF,AC3
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,AC14 ; AC1,AC14
MOVE AC4,AC14 ; AC4,AC14
EXTEND AC1,C.8 ; AC1,[MOVSLJ ]
JFCL ;
SETZ AC2, ; AC2,
MOVEI AC4,0(AC3) ; AC4,0(AC3)
HRLI AC4,-337100 ; AC4,-337100
MOVE AC1,AC14 ; AC1,AC14
ADJBP AC1,AC4 ; AC1,AC4
IDPB AC2,AC1 ; AC2,AC1
MOVEI AC1,-2(SP) ; AC1,GS
PUSHJ SP,PCICGS ; SP,PCICGS
ADJSP SP,-3 ; SP,-3
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.6: POINT 3,-2(SP),4 ; 3,GS,4
C.7: POINT 1,-2(SP),5 ; 1,GS,5
C.8: MOVSLJ ;
; Routine Size: 56 words
; 0480
; 0481 GLOBAL ROUTINE PCIDFS(NAME,ORIG): NOVALUE = ! Define synonym
; 0482
; 0483 !++
; 0484 ! Functional description:
; 0485 ! Make a global symbol table entry for a synonym, and
; 0486 ! define it. This may actually be a null definition,
; 0487 ! generated by Undeclare Original.
; 0488 !
; 0489 ! Formal parameters:
; 0490 ! Stringvalue to synonym name string
; 0491 ! Address of target command name string, or 0
; 0492 !
; 0493 ! Implicit inputs:
; 0494 ! None
; 0495 !
; 0496 ! Implicit outputs:
; 0497 ! Global symbol table
; 0498 !
; 0499 ! Routine value:
; 0500 ! None
; 0501 !
; 0502 ! Side effects:
; 0503 ! None
; 0504 !
; 0505 !--
; 0506
; 0507 BEGIN
; 0508 EXTERNAL REGISTER Z=0;
; 0509 MAP
; 0510 NAME: STR_VAL;
; 0511 LOCAL
; 0512 PTR,
; 0513 CNT,
; 0514 GS: GST_BLK;
; 0515 IF .ORIG NEQ 0
; 0516 THEN
; 0517 BEGIN
; 0518 CNT = 0;
; 0519 PTR = BYTPTR(.ORIG);
; 0520 DO CNT=.CNT+1 WHILE CH$RCHAR_A(PTR) NEQ 0;
; 0521 GS[GST_PLN] = .CNT;
; 0522 GS[GST_TXT] = PCMGMM((.CNT+4)/5, PCTXFR);
; 0523 CH$MOVE(.CNT,BYTPTR(.ORIG),BYTPTR(.GS[GST_TXT]));
; 0524 END
; 0525 ELSE
; 0526 GS[GST_PLN] = GS[GST_TXT] = 0;
; 0527 GS[GST_CLS] = GST_CLS_SYN;
; 0528 GS[GST_NML] = .NAME[STV_LEN];
; 0529 ! Must have additional word before string to allow for abbrevations
; 0530 GS[GST_NMA] = PCMGMM((.NAME[STV_LEN]+10)/5 + 1, PCTXFR) + 1;
; 0531 CH$MOVE(.NAME[STV_LEN]+1, BYTPTR(.NAME[STV_ADR]), BYTPTR(.GS[GST_NMA]));
; 0532 PCICGS(GS)
; 0533 END;
PCIDFS::PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,3 ; SP,3
MOVE AC13,AC2 ; ORIG,AC2
MOVE AC12,AC1 ; NAME,AC1
MOVEI AC1,-2(SP) ; AC1,GS
ADDI AC1,1 ; AC1,1
JUMPE AC13,L.15 ; ORIG,L.15
SETZ AC14, ; CNT,
MOVE AC2,AC13 ; HLF,ORIG
HRLI AC2,-337100 ; HLF,-337100
L.14: ADDI AC14,1 ; CNT,1
ILDB AC3,AC2 ; AC3,PTR
JUMPN AC3,L.14 ; AC3,L.14
DPB AC14,C.9 ; CNT,[POINT 9,0(AC1),35] <0,9>
MOVE AC1,AC14 ; AC1,CNT
ADDI AC1,4 ; AC1,4
IDIVI AC1,5 ; AC1,5
MOVEI AC2,PCTXFR ; AC2,PCTXFR
PUSHJ SP,PCMGMM ; SP,PCMGMM
HRRM AC1,-2(SP) ; AC1,GS
MOVE AC2,AC13 ; HLF,ORIG
HRLI AC2,-337100 ; HLF,-337100
HRRZ AC5,-2(SP) ; HLF,GS
HRLI AC5,-337100 ; HLF,-337100
MOVE AC1,AC14 ; AC1,CNT
MOVE AC4,AC14 ; AC4,CNT
EXTEND AC1,C.8 ; AC1,[MOVSLJ ]
JFCL ;
JRST L.16 ; L.16
L.15: HLLZS -2(SP) ; GS
MOVEI AC2,777 ; AC2,777
ANDCAM AC2,0(AC1) ; AC2,0(AC1)
L.16: MOVEI AC1,4 ; AC1,4
DPB AC1,C.6 ; AC1,[POINT 3,-2(SP),4] <31,3>
HLLM AC12,0(SP) ; NAME,GS+2
HLRZ AC1,AC12 ; AC1,NAME
ADDI AC1,12 ; AC1,12
IDIVI AC1,5 ; AC1,5
ADDI AC1,1 ; AC1,1
MOVEI AC2,PCTXFR ; AC2,PCTXFR
PUSHJ SP,PCMGMM ; SP,PCMGMM
ADDI AC1,1 ; AC1,1
HRRM AC1,0(SP) ; AC1,GS+2
HLRZ AC1,AC12 ; AC1,NAME
ADDI AC1,1 ; AC1,1
MOVEI AC2,0(AC12) ; HLF,0(NAME)
HRLI AC2,-337100 ; HLF,-337100
HRRZ AC5,0(SP) ; HLF,GS+2
HRLI AC5,-337100 ; HLF,-337100
MOVE AC4,AC1 ; AC4,AC1
EXTEND AC1,C.8 ; AC1,[MOVSLJ ]
JFCL ;
MOVEI AC1,-2(SP) ; AC1,GS
PUSHJ SP,PCICGS ; SP,PCICGS
ADJSP SP,-3 ; SP,-3
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.9: POINT 9,0(AC1),35 ; 9,0(AC1),35
; Routine Size: 62 words
; 0534
; 0535 GLOBAL ROUTINE PCIWEV(JFN): NOVALUE = ! Write environment
; 0536
; 0537 !++
; 0538 ! Functional description:
; 0539 ! Writes PCL environment on provided file.
; 0540 !
; 0541 ! Formal parameters:
; 0542 ! JFN of open file
; 0543 !
; 0544 ! Implicit inputs:
; 0545 ! Commands, procedures, variables, synonyms
; 0546 !
; 0547 ! Implicit outputs:
; 0548 ! None
; 0549 !
; 0550 ! Routine value:
; 0551 ! None
; 0552 !
; 0553 ! Side effects:
; 0554 ! None
; 0555 !
; 0556 !--
; 0557
; 0558 BEGIN
; 0559 EXTERNAL REGISTER Z=0;
; 0560 LOCAL
; 0561 CMDCNT,
; 0562 CNT,
; 0563 GS: REF GST_BLK,
; 0564 LEN;
; 0565
; 0566 MACRO
; M 0567 OUTFILE(WRD) =
; M 0568 BEGIN
; M 0569 REGISTER R1=1,R2=2;
; M 0570 R1 = .JFN;
; M 0571 R2 = WRD;
; M 0572 JSYS(0,BOUT,R1,R2)
; 0573 END %,
; M 0574 OUTFILES(PTR,LEN) =
; M 0575 BEGIN
; M 0576 REGISTER R1=1,R2=2,R3=3;
; M 0577 R1 = .JFN;
; M 0578 R2 = PTR;
; M 0579 R3 = LEN;
; M 0580 JSYS(0,SOUT,R1,R2,R3)
; 0581 END %;
; 0582
; 0583 ! Environment file format number
; 0584 OUTFILE(ENVIR_NUM);
; 0585 CMDCNT = 0;
; 0586 CNT = 0;
; 0587 INCR I TO .PCLGST-1 DO
; 0588 BEGIN
; 0589 LOCAL
; 0590 CLS,
; 0591 GS: REF GST_BLK;
; 0592 GS = PCGBST[.I,GST_VLD];
; 0593 IF .GS[GST_VLD] NEQ 0
; 0594 THEN
; 0595 IF .GS[GST_PSV] EQL 0 OR (.GS[GST_PSV] AND .GS[GST_SPR] EQL 0)
; 0596 THEN
; 0597 BEGIN
; 0598 CNT = .CNT + 1;
; 0599 CLS = .GS[GST_CLS];
; 0600 IF .CLS EQL GST_CLS_CMD
; 0601 OR (.CLS EQL GST_CLS_SYN AND .GS[GST_TXT] NEQ 0)
; 0602 THEN
; 0603 CMDCNT=.CMDCNT+1
; 0604 END
; 0605 END;
; 0606 ! Number of commands
; 0607 OUTFILE(.CMDCNT);
; 0608 ! Number of objects
; 0609 OUTFILE(.CNT);
; 0610 INCR I TO .PCLGST-1 DO
; 0611 IF .PCGBST[.I,GST_VLD] NEQ 0 AND ((.PCGBST[.I,GST_PSV] EQL 0) OR
; 0612 (.PCGBST[.I,GST_PSV] AND .PCGBST[.I,GST_SPR] EQL 0))
; 0613 THEN
; 0614 BEGIN
; 0615 GS = PCGBST[.I,GST_VLD];
; 0616 ! First word of GST entry
; 0617 OUTFILE(.GS[GST_VLD]);
; 0618 ! Second word of GST entry
; 0619 OUTFILE(.GS[GST_VAL]);
; 0620 ! Character length of name
; 0621 OUTFILE(.GS[GST_NML]);
; 0622 LEN = -(.GS[GST_NML]+5)/5;
; 0623 ! Name
; 0624 OUTFILES( CH$PTR(.GS[GST_NMA],0,36), .LEN);
; 0625 LEN = (CASE .GS[GST_CLS] FROM GST_CLS_CMD TO GST_CLS_SYN OF
; 0626 SET
; 0627 [GST_CLS_CMD]: .GS[GST_COD] + .GS[GST_CNS]
; 0628 + .GS[GST_SML]*STE_LEN;
; 0629 [GST_CLS_PRC,
; 0630 GST_CLS_FCN]: .GS[GST_COD] + .GS[GST_PCT] + .GS[GST_CNS]
; 0631 + .GS[GST_SML]*STE_LEN;
; 0632 [GST_CLS_VAR]: IF .GS[GST_TYP] EQL GST_TYP_INT
; 0633 THEN
; 0634 0
; 0635 ELSE
; 0636 BEGIN
; 0637 LOCAL
; 0638 STR: STR_VAL;
; 0639 STR = .GS[GST_VAL];
; 0640 (.STR[STV_LEN]+4)/5
; 0641 END;
; 0642 [GST_CLS_SYN]: (.GS[GST_PLN]+4)/5
; 0643 TES);
; 0644 IF .LEN NEQ 0
; 0645 THEN
; 0646 ! Text
; 0647 BEGIN
; 0648 LOCAL
; 0649 SRC;
; 0650 IF .GS[GST_CLS] EQL GST_CLS_VAR
; 0651 THEN
; 0652 BEGIN
; 0653 LOCAL
; 0654 STR: STR_VAL;
; 0655 STR = .GS[GST_VAL];
; 0656 SRC = .STR[STV_ADR]
; 0657 END
; 0658 ELSE
; 0659 SRC = .GS[GST_TXT];
; 0660 OUTFILES( CH$PTR(.SRC,0,36), -.LEN)
; 0661 END
; 0662
; 0663 END
; 0664 END;
PCIWEV::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC16,AC1 ; JFN,AC1
MOVE AC2,C.22 ; R2,[123456000004]
JSYS 51 ; 51
SETZB AC4,AC5 ; CMDCNT,CNT
SETO AC3, ; I,
JRST L.20 ; L.20
L.17: MOVE AC1,AC3 ; AC1,I
IMULI AC1,3 ; AC1,3
ADDI AC1,PCGBST ; AC1,PCGBST
SKIPN 0(AC1) ; 0(GS)
JRST L.20 ; L.20
LDB AC2,C.10 ; AC2,[POINT 1,0(GS),0] <35,1>
JUMPE AC2,L.18 ; AC2,L.18
TRNN AC2,1 ; AC2,1
JRST L.20 ; L.20
LDB AC2,C.11 ; AC2,[POINT 1,0(GS),1] <34,1>
JUMPN AC2,L.20 ; AC2,L.20
L.18: ADDI AC5,1 ; CNT,1
LDB AC2,C.12 ; CLS,[POINT 3,0(GS),4] <31,3>
JUMPE AC2,L.19 ; CLS,L.19
CAIE AC2,4 ; CLS,4
JRST L.20 ; L.20
HRRZ AC2,0(AC1) ; AC2,0(GS)
JUMPE AC2,L.20 ; AC2,L.20
L.19: ADDI AC4,1 ; CMDCNT,1
L.20: ADDI AC3,1 ; I,1
CAMGE AC3,PCLGST ; I,PCLGST
JRST L.17 ; L.17
MOVE AC1,AC16 ; R1,JFN
MOVE AC2,AC4 ; R2,CMDCNT
JSYS 51 ; 51
MOVE AC1,AC16 ; R1,JFN
MOVE AC2,AC5 ; R2,CNT
JSYS 51 ; 51
MOVE AC13,PCLGST ; AC13,PCLGST
SETO AC14, ; I,
JRST L.33 ; L.33
L.21: MOVE AC1,AC14 ; AC1,I
IMULI AC1,3 ; AC1,3
SKIPN PCGBST(AC1) ; PCGBST(AC1)
JRST L.33 ; L.33
LDB AC2,C.13 ; AC2,[POINT 1,PCGBST(AC1),0] <35,1>
JUMPE AC2,L.22 ; AC2,L.22
TRNN AC2,1 ; AC2,1
JRST L.33 ; L.33
LDB AC2,C.14 ; AC2,[POINT 1,PCGBST(AC1),1] <34,1>
JUMPN AC2,L.33 ; AC2,L.33
L.22: MOVEI AC4,PCGBST(AC1) ; GS,PCGBST(AC1)
MOVE AC1,AC16 ; R1,JFN
MOVE AC2,0(AC4) ; R2,0(GS)
JSYS 51 ; 51
MOVE AC1,AC16 ; R1,JFN
MOVE AC2,1(AC4) ; R2,1(GS)
JSYS 51 ; 51
MOVE AC1,AC16 ; R1,JFN
HLRZ AC2,2(AC4) ; R2,2(GS)
JSYS 51 ; 51
HLRZ AC3,2(AC4) ; AC3,2(GS)
ADDI AC3,5 ; AC3,5
MOVE AC1,AC3 ; AC1,AC3
IDIVI AC1,5 ; AC1,5
MOVE AC3,AC1 ; AC3,AC1
MOVN AC5,AC3 ; LEN,AC3
MOVE AC1,AC16 ; R1,JFN
HRRZ AC2,2(AC4) ; AC2,2(GS)
MOVEI AC2,-1(AC2) ; AC2,-1(AC2)
HRLI AC2,4400 ; AC2,4400
MOVE AC3,AC5 ; R3,LEN
JSYS 53 ; 53
LDB AC3,C.15 ; AC3,[POINT 3,0(GS),4] <31,3>
JRST L.23(AC3) ; L.23(AC3)
L.23: JRST L.24 ; L.24
JRST L.25 ; L.25
JRST L.26 ; L.26
JRST L.25 ; L.25
JRST L.28 ; L.28
L.24: LDB AC2,C.16 ; AC2,[POINT 12,1(GS),35] <0,12>
LDB AC1,C.17 ; AC1,[POINT 12,1(GS),23] <12,12>
ADD AC2,AC1 ; AC2,AC1
LDB AC1,C.18 ; AC1,[POINT 12,1(GS),11] <24,12>
IMULI AC1,2 ; AC1,2
MOVE AC5,AC2 ; LEN,AC2
ADD AC5,AC1 ; LEN,AC1
JRST L.30 ; L.30
L.25: LDB AC1,C.16 ; AC1,[POINT 12,1(GS),35] <0,12>
LDB AC2,C.19 ; AC2,[POINT 4,0(GS),9] <26,4>
ADD AC1,AC2 ; AC1,AC2
LDB AC2,C.17 ; AC2,[POINT 12,1(GS),23] <12,12>
ADD AC1,AC2 ; AC1,AC2
LDB AC2,C.18 ; AC2,[POINT 12,1(GS),11] <24,12>
IMULI AC2,2 ; AC2,2
MOVE AC5,AC1 ; LEN,AC1
ADD AC5,AC2 ; LEN,AC2
JRST L.30 ; L.30
L.26: LDB AC1,C.20 ; AC1,[POINT 1,0(GS),5] <30,1>
JUMPN AC1,L.27 ; AC1,L.27
SETZ AC5, ; LEN,
JRST L.30 ; L.30
L.27: MOVE AC1,1(AC4) ; STR,1(GS)
HLRZ AC1,AC1 ; AC1,STR
JRST L.29 ; L.29
L.28: LDB AC1,C.21 ; AC1,[POINT 9,1(GS),35] <0,9>
L.29: ADDI AC1,4 ; AC1,4
IDIVI AC1,5 ; AC1,5
MOVE AC5,AC1 ; LEN,AC1
L.30: JUMPE AC5,L.33 ; LEN,L.33
CAIE AC3,2 ; AC3,2
JRST L.31 ; L.31
MOVE AC1,1(AC4) ; STR,1(GS)
MOVEI AC2,0(AC1) ; SRC,0(STR)
JRST L.32 ; L.32
L.31: HRRZ AC2,0(AC4) ; SRC,0(GS)
L.32: MOVE AC1,AC16 ; R1,JFN
MOVEI AC2,-1(AC2) ; AC2,-1(AC2)
HRLI AC2,4400 ; AC2,4400
MOVN AC3,AC5 ; R3,LEN
JSYS 53 ; 53
L.33: ADDI AC14,1 ; I,1
CAMGE AC14,AC13 ; I,AC13
JRST L.21 ; L.21
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.10: POINT 1,0(AC1),0 ; 1,0(GS),0
C.11: POINT 1,0(AC1),1 ; 1,0(GS),1
C.12: POINT 3,0(AC1),4 ; 3,0(GS),4
C.13: POINT 1,PCGBST(AC1),0 ; 1,PCGBST(AC1),0
C.14: POINT 1,PCGBST(AC1),1 ; 1,PCGBST(AC1),1
C.15: POINT 3,0(AC4),4 ; 3,0(GS),4
C.16: POINT 12,1(AC4),35 ; 12,1(GS),35
C.17: POINT 12,1(AC4),23 ; 12,1(GS),23
C.18: POINT 12,1(AC4),11 ; 12,1(GS),11
C.19: POINT 4,0(AC4),9 ; 4,0(GS),9
C.20: POINT 1,0(AC4),5 ; 1,0(GS),5
C.21: POINT 9,1(AC4),35 ; 9,1(GS),35
C.22: EXP 123456000004 ; 123456000004
; Routine Size: 138 words
; 0665
; 0666 GLOBAL ROUTINE PCIGEV(JFN): NOVALUE = ! Define environment
; 0667
; 0668 !++
; 0669 ! Functional description:
; 0670 ! Reads an environment file and defines all the PCL objects
; 0671 ! contained therein.
; 0672 !
; 0673 ! Formal parameters:
; 0674 ! JFN of open file
; 0675 !
; 0676 ! Implicit inputs:
; 0677 ! None
; 0678 !
; 0679 ! Implicit outputs:
; 0680 ! Commands, procedures, variables, synonyms
; 0681 !
; 0682 ! Routine value:
; 0683 ! None
; 0684 !
; 0685 ! Side effects:
; 0686 ! None
; 0687 !
; 0688 !--
; 0689
; 0690 BEGIN
; 0691 EXTERNAL REGISTER Z=0;
; 0692 LOCAL
; 0693 CNT, ! Object count
; 0694 LEN,
; 0695 GS: BLOCK[GST_LEN] FIELD (GST_FLD); ! A global symbol entry
; 0696
; 0697 MACRO
; M 0698 INFILE =
; M 0699 BEGIN
; M 0700 REGISTER R1=1,R2=2;
; M 0701 R1 = .JFN;
; M 0702 JSYS(0,BIN,R1,R2);
; M 0703 .R2
; 0704 END %,
; M 0705 INFILES (PTR,CNT) =
; M 0706 BEGIN
; M 0707 REGISTER R1=1,R2=2,R3=3;
; M 0708 R1 = .JFN;
; M 0709 R2 = PTR;
; M 0710 R3 = CNT;
; M 0711 JSYS(0,SIN,R1,R2,R3)
; 0712 END %;
; 0713
; 0714 ! Environment file format number
; 0715 IF INFILE NEQ ENVIR_NUM
; 0716 THEN
; 0717 PCMCER(UPLIT(%ASCIZ 'File is not compatible environment file'));
; 0718 ! Number of commands and synonyms
; 0719 CNT = INFILE;
; 0720 IF .CNT NEQ 0
; 0721 THEN
; 0722 PCMRKT(.CNT);
; 0723 ! Number of objects
; 0724 CNT = INFILE;
; 0725 WHILE
; 0726 .CNT GTR 0
; 0727 DO
; 0728 BEGIN
; 0729 ! First word of GST entry
; 0730 GS[GST_VLD] = INFILE;
; 0731 ! Second word of GST entry
; 0732 GS[GST_VAL] = INFILE;
; 0733 ! Character length of name
; 0734 GS[GST_NML] = INFILE;
; 0735 LEN = (.GS[GST_NML]+5)/5;
; 0736 IF .GS[GST_CLS] EQL GST_CLS_SYN
; 0737 THEN
; 0738 ! Extra word in case a synonym entry must be made
; 0739 GS[GST_NMA] = PCMGMM(.LEN+1, PCTXFR) + 1
; 0740 ELSE
; 0741 GS[GST_NMA] = PCMGMM(.LEN, PCTXFR);
; 0742 ! Name
; 0743 INFILES(CH$PTR(.GS[GST_NMA],0,36), -.LEN);
; 0744 LEN = (CASE .GS[GST_CLS] FROM GST_CLS_CMD TO GST_CLS_SYN OF
; 0745 SET
; 0746 [GST_CLS_CMD]: .GS[GST_COD] + .GS[GST_CNS] + .GS[GST_SML]*STE_LEN;
; 0747 [GST_CLS_PRC,
; 0748 GST_CLS_FCN]: .GS[GST_COD] + .GS[GST_PCT] + .GS[GST_CNS]
; 0749 + .GS[GST_SML]*STE_LEN;
; 0750 [GST_CLS_VAR]: IF .GS[GST_TYP] EQL GST_TYP_STR
; 0751 THEN
; 0752 BEGIN
; 0753 LOCAL
; 0754 STR: STR_VAL;
; 0755 STR = .GS[GST_VAL];
; 0756 (.STR[STV_LEN]+4)/5
; 0757 END
; 0758 ELSE
; 0759 0;
; 0760 [GST_CLS_SYN]: (.GS[GST_PLN]+4)/5
; 0761 TES);
; 0762 IF .LEN NEQ 0
; 0763 THEN
; 0764 BEGIN
; 0765 LOCAL
; 0766 DST;
; 0767 DST = PCMGMM(.LEN, PCTXFR);
; 0768 ! Text or value of string variable
; 0769 INFILES( CH$PTR(.DST,0,36), -.LEN);
; 0770 IF .GS[GST_CLS] EQL GST_CLS_VAR
; 0771 THEN
; 0772 BEGIN
; 0773 LOCAL
; 0774 STR: STR_VAL;
; 0775 STR = .GS[GST_VAL];
; 0776 STR[STV_ADR] = .DST;
; 0777 GS[GST_VAL] = .STR
; 0778 END
; 0779 ELSE
; 0780 GS[GST_TXT] = .DST
; 0781 END;
; 0782 PCICGS(GS);
; 0783 CNT = .CNT - 1
; 0784 END
; 0785 END;
P.AAB: BYTE (7)"F","i","l","e"," " ; File
BYTE (7)"i","s"," ","n","o" ; is no
BYTE (7)"t"," ","c","o","m" ; t com
BYTE (7)"p","a","t","i","b" ; patib
BYTE (7)"l","e"," ","e","n" ; le en
BYTE (7)"v","i","r","o","n" ; viron
BYTE (7)"m","e","n","t"," " ; ment
BYTE (7)"f","i","l","e",000 ; file
PCIGEV::PUSH SP,AC10 ; SP,AC10
PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,3 ; SP,3
MOVE AC12,AC1 ; JFN,AC1
JSYS 50 ; 50
CAMN AC2,C.22 ; R2,[123456000004]
JRST L.34 ; L.34
MOVEI AC1,P.AAB ; AC1,P.AAB
PUSHJ SP,PCMCER ; SP,PCMCER
L.34: MOVE AC1,AC12 ; R1,JFN
JSYS 50 ; 50
MOVE AC10,AC2 ; CNT,R2
JUMPE AC10,L.35 ; CNT,L.35
MOVE AC1,AC10 ; AC1,CNT
PUSHJ SP,PCMRKT ; SP,PCMRKT
L.35: MOVE AC1,AC12 ; R1,JFN
JSYS 50 ; 50
MOVE AC10,AC2 ; CNT,R2
MOVEI AC1,-2(SP) ; AC1,GS
MOVE AC14,AC1 ; AC14,AC1
ADDI AC14,1 ; AC14,1
MOVEI AC1,-2(SP) ; AC1,GS
MOVE AC11,AC1 ; AC11,AC1
ADDI AC11,2 ; AC11,2
L.36: JUMPLE AC10,L.50 ; CNT,L.50
MOVE AC1,AC12 ; R1,JFN
JSYS 50 ; 50
MOVEM AC2,-2(SP) ; R2,GS
MOVE AC1,AC12 ; R1,JFN
JSYS 50 ; 50
MOVEM AC2,0(AC14) ; R2,0(AC14)
MOVE AC1,AC12 ; R1,JFN
JSYS 50 ; 50
HRLM AC2,0(AC11) ; R2,0(AC11)
HLRZ AC1,0(AC11) ; AC1,0(AC11)
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVE AC13,AC1 ; LEN,AC1
LDB AC1,C.6 ; AC1,[POINT 3,-2(SP),4] <31,3>
CAIE AC1,4 ; AC1,4
JRST L.37 ; L.37
MOVE AC1,AC13 ; AC1,LEN
ADDI AC1,1 ; AC1,1
MOVEI AC2,PCTXFR ; AC2,PCTXFR
PUSHJ SP,PCMGMM ; SP,PCMGMM
AOJA AC1,L.38 ; AC1,L.38
L.37: MOVE AC1,AC13 ; AC1,LEN
MOVEI AC2,PCTXFR ; AC2,PCTXFR
PUSHJ SP,PCMGMM ; SP,PCMGMM
L.38: HRRM AC1,0(AC11) ; AC1,0(AC11)
MOVE AC1,AC12 ; R1,JFN
HRRZ AC2,0(AC11) ; AC2,0(AC11)
MOVEI AC2,-1(AC2) ; AC2,-1(AC2)
HRLI AC2,4400 ; AC2,4400
MOVN AC3,AC13 ; R3,LEN
JSYS 52 ; 52
LDB AC1,C.6 ; AC1,[POINT 3,-2(SP),4] <31,3>
JRST L.39(AC1) ; L.39(AC1)
L.39: JRST L.40 ; L.40
JRST L.41 ; L.41
JRST L.43 ; L.43
JRST L.41 ; L.41
JRST L.45 ; L.45
L.40: LDB AC2,C.23 ; AC2,[POINT 12,0(AC14),35] <0,12>
JRST L.42 ; L.42
L.41: LDB AC2,C.23 ; AC2,[POINT 12,0(AC14),35] <0,12>
LDB AC1,C.24 ; AC1,[POINT 4,GS,9] <26,4>
ADD AC2,AC1 ; AC2,AC1
L.42: LDB AC1,C.25 ; AC1,[POINT 12,0(AC14),23] <12,12>
ADD AC2,AC1 ; AC2,AC1
LDB AC1,C.26 ; AC1,[POINT 12,0(AC14),11] <24,12>
IMULI AC1,2 ; AC1,2
MOVE AC13,AC2 ; LEN,AC2
ADD AC13,AC1 ; LEN,AC1
JRST L.47 ; L.47
L.43: LDB AC1,C.7 ; AC1,[POINT 1,-2(SP),5] <30,1>
CAIE AC1,1 ; AC1,1
JRST L.44 ; L.44
MOVE AC1,0(AC14) ; STR,0(AC14)
HLRZ AC1,AC1 ; AC1,STR
JRST L.46 ; L.46
L.44: SETZ AC13, ; LEN,
JRST L.47 ; L.47
L.45: LDB AC1,C.27 ; AC1,[POINT 9,0(AC14),35] <0,9>
L.46: ADDI AC1,4 ; AC1,4
IDIVI AC1,5 ; AC1,5
MOVE AC13,AC1 ; LEN,AC1
L.47: JUMPE AC13,L.49 ; LEN,L.49
MOVE AC1,AC13 ; AC1,LEN
MOVEI AC2,PCTXFR ; AC2,PCTXFR
PUSHJ SP,PCMGMM ; SP,PCMGMM
MOVE AC4,AC1 ; DST,AC1
MOVE AC1,AC12 ; R1,JFN
MOVE AC2,AC4 ; AC2,DST
MOVEI AC2,-1(AC2) ; AC2,-1(AC2)
HRLI AC2,4400 ; AC2,4400
MOVN AC3,AC13 ; R3,LEN
JSYS 52 ; 52
LDB AC1,C.6 ; AC1,[POINT 3,-2(SP),4] <31,3>
CAIE AC1,2 ; AC1,2
JRST L.48 ; L.48
MOVE AC1,0(AC14) ; STR,0(AC14)
HRR AC1,AC4 ; STR,DST
MOVEM AC1,0(AC14) ; STR,0(AC14)
JRST L.49 ; L.49
L.48: HRRM AC4,-2(SP) ; DST,GS
L.49: MOVEI AC1,-2(SP) ; AC1,GS
PUSHJ SP,PCICGS ; SP,PCICGS
SOJA AC10,L.36 ; CNT,L.36
L.50: ADJSP SP,-3 ; SP,-3
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POP SP,AC10 ; SP,AC10
POPJ SP, ; SP,
C.23: POINT 12,0(AC14),35 ; 12,0(AC14),35
C.24: POINT 4,-2(SP),9 ; 4,GS,9
C.25: POINT 12,0(AC14),23 ; 12,0(AC14),23
C.26: POINT 12,0(AC14),11 ; 12,0(AC14),11
C.27: POINT 9,0(AC14),35 ; 9,0(AC14),35
; Routine Size: 124 words
; 0786
; 0787 GLOBAL ROUTINE PCIPSV: NOVALUE = ! Mark all symbols as preserved
; 0788
; 0789 !++
; 0790 ! Functional description:
; 0791 ! Mark all symbols as preserved.
; 0792 !
; 0793 ! Formal parameters:
; 0794 ! None
; 0795 !
; 0796 ! Implicit inputs:
; 0797 ! Symbol table
; 0798 !
; 0799 ! Implicit outputs:
; 0800 ! None
; 0801 !
; 0802 ! Routine value:
; 0803 ! None
; 0804 !
; 0805 ! Side effects:
; 0806 ! None
; 0807 !
; 0808 !--
; 0809
; 0810 DECR I FROM .PCLGST-1 DO
; 0811 IF .PCGBST[.I,GST_VLD] NEQ 0 THEN
; 0812 PCGBST[.I,GST_PSV] = 1;
PCIPSV::MOVE AC2,PCLGST ; I,PCLGST
JRST L.52 ; L.52
L.51: MOVE AC1,AC2 ; AC1,I
IMULI AC1,3 ; AC1,3
SKIPN PCGBST(AC1) ; PCGBST(AC1)
JRST L.52 ; L.52
MOVSI AC3,400000 ; AC3,400000
IORM AC3,PCGBST(AC1) ; AC3,PCGBST(AC1)
L.52: SOJGE AC2,L.51 ; I,L.51
POPJ SP, ; SP,
; Routine Size: 10 words
; 0813
; 0814 GLOBAL ROUTINE PCIUDF(NAMPTR) = ! Undefine global object
; 0815
; 0816 !++
; 0817 ! Functional description:
; 0818 ! Removes global symbol table entry for given object,
; 0819 ! and frees all storage associated with it. If object
; 0820 ! is preserved, sets object to be superceded. If object
; 0821 ! was a duplicate, find the preserved object with the
; 0822 ! same name and un-supercede it.
; 0823 !
; 0824 ! Formal parameters:
; 0825 ! Stringvalue of name of object
; 0826 !
; 0827 ! Implicit inputs:
; 0828 ! Global symbol table
; 0829 !
; 0830 ! Implicit outputs:
; 0831 ! Global symbol table, Text area, permanent storage pool
; 0832 !
; 0833 ! Routine value:
; 0834 ! TRUE if undefined, FALSE if not defined
; 0835 !
; 0836 ! Side effects:
; 0837 ! None
; 0838 !
; 0839 !--
; 0840
; 0841 BEGIN
; 0842 EXTERNAL REGISTER Z=0;
; 0843 LOCAL
; 0844 GS: REF GST_BLK, ! Entry being deleted
; 0845 PRESRV: REF GST_BLK; ! Formerly superceded entry
; 0846 MAP
; 0847 NAMPTR: STR_VAL;
; 0848 PRESRV = 0;
; 0849 GS = PCIFGS(.NAMPTR,0);
; 0850 IF .GS LEQ 0 THEN RETURN FALSE;
; 0851 IF .GS[GST_PSV]
; 0852 THEN
; 0853 BEGIN
; 0854 GS[GST_SPR] = 1;
; 0855 RETURN FALSE
; 0856 END;
; 0857 IF .GS[GST_DPL]
; 0858 THEN
; 0859 DECR I FROM .PCLGST-1 DO
; 0860 IF .PCGBST[.I,GST_VLD] NEQ 0 THEN
; 0861 IF .PCGBST[.I,GST_PSV] THEN
; 0862 IF .GS[GST_NML] EQL .PCGBST[.I,GST_NML] THEN
; 0863 IF CH$EQL(.GS[GST_NML], BYTPTR(.GS[GST_NMA]),
; 0864 .GS[GST_NML], BYTPTR(.PCGBST[.I,GST_NMA]))
; 0865 THEN
; 0866 BEGIN
; 0867 PRESRV = PCGBST[.I,GST_VLD];
; 0868 EXITLOOP
; 0869 END;
; 0870 FREESTG(.GS);
; 0871 PCMUDF(.GS[GST_CLS],.GS[GST_NMA]);
; 0872 IF .PRESRV NEQ 0
; 0873 THEN
; 0874 BEGIN
; 0875 PRESRV[GST_SPR] = 0;
; 0876 PCMDFO(.PRESRV[GST_CLS], .PRESRV[GST_NMA], 0, .PRESRV[GST_TXT])
; 0877 END;
; 0878 IF .GS[GST_CLS] EQL GST_CLS_SYN
; 0879 THEN
; 0880 RETMEM((.GS[GST_NML]+10)/5, .GS[GST_NMA]-1, PCTXFR)
; 0881 ELSE
; 0882 RETMEM((.GS[GST_NML]+5)/5, .GS[GST_NMA], PCTXFR);
; 0883 GS[GST_VLD] = 0;
; 0884 TRUE
; 0885 END;
PCIUDF::PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
SETZB AC13,AC2 ; PRESRV,AC2
PUSHJ SP,PCIFGS ; SP,PCIFGS
MOVE AC14,AC1 ; GS,AC1
JUMPLE AC14,L.53 ; GS,L.53
SKIPL 0(AC14) ; 0(GS)
JRST L.54 ; L.54
MOVSI AC1,200000 ; AC1,200000
IORM AC1,0(AC14) ; AC1,0(GS)
L.53: SETZ AC1, ; AC1,
JRST L.61 ; L.61
L.54: MOVSI AC1,200000 ; AC1,200000
TDNN AC1,0(AC14) ; AC1,0(GS)
JRST L.57 ; L.57
MOVE AC16,PCLGST ; I,PCLGST
JRST L.56 ; L.56
L.55: MOVE AC3,AC16 ; AC3,I
IMULI AC3,3 ; AC3,3
SKIPE PCGBST(AC3) ; PCGBST(AC3)
SKIPL PCGBST(AC3) ; PCGBST(AC3)
JRST L.56 ; L.56
HLRZ AC1,2(AC14) ; AC1,2(GS)
HLRZ AC2,PCGBST+2(AC3) ; AC2,PCGBST+2(AC3)
CAME AC1,AC2 ; AC1,AC2
JRST L.56 ; L.56
HRRZ AC2,2(AC14) ; HLF,2(GS)
HRLI AC2,-337100 ; HLF,-337100
HRRZ AC5,PCGBST+2(AC3) ; HLF,PCGBST+2(AC3)
HRLI AC5,-337100 ; HLF,-337100
HLRZ AC1,2(AC14) ; AC1,2(GS)
HLRZ AC4,2(AC14) ; AC4,2(GS)
EXTEND AC1,C.2 ; AC1,[CMPSE ]
JRST L.56 ; L.56
MOVEI AC13,PCGBST(AC3) ; PRESRV,PCGBST(AC3)
JRST L.57 ; L.57
L.56: SOJGE AC16,L.55 ; I,L.55
L.57: MOVE AC1,AC14 ; AC1,GS
PUSHJ SP,FREESTG ; SP,FREESTG
LDB AC12,C.4 ; AC12,[POINT 3,0(AC14),4] <31,3>
MOVE AC1,AC12 ; AC1,AC12
HRRZ AC2,2(AC14) ; AC2,2(GS)
PUSHJ SP,PCMUDF ; SP,PCMUDF
JUMPE AC13,L.58 ; PRESRV,L.58
MOVSI AC1,200000 ; AC1,200000
ANDCAM AC1,0(AC13) ; AC1,0(PRESRV)
LDB AC1,C.28 ; AC1,[POINT 3,0(PRESRV),4] <31,3>
HRRZ AC2,2(AC13) ; AC2,2(PRESRV)
SETZ AC3, ; AC3,
HRRZ AC4,0(AC13) ; AC4,0(PRESRV)
PUSHJ SP,PCMDFO ; SP,PCMDFO
L.58: CAIE AC12,4 ; AC12,4
JRST L.59 ; L.59
HLRZ AC1,2(AC14) ; AC1,2(GS)
ADDI AC1,12 ; AC1,12
IDIVI AC1,5 ; AC1,5
HRRZ AC2,2(AC14) ; AC2,2(GS)
SOJA AC2,L.60 ; AC2,L.60
L.59: HLRZ AC1,2(AC14) ; AC1,2(GS)
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
HRRZ AC2,2(AC14) ; AC2,2(GS)
L.60: MOVEI AC3,PCTXFR ; AC3,PCTXFR
PUSHJ SP,RETMEM ; SP,RETMEM
SETZM 0(AC14) ; 0(GS)
SETO AC1, ; AC1,
L.61: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.28: POINT 3,0(AC13),4 ; 3,0(PRESRV),4
; Routine Size: 72 words
; 0886
; 0887 ROUTINE FREESTG(
; 0888 GS: REF GST_BLK ! Address of GST entry to release
; 0889 ): NOVALUE = ! Free memory relating to global symbol
; 0890
; 0891 !++
; 0892 ! Functional description:
; 0893 ! Releases all storage associated with a global symbol entry.
; 0894 !
; 0895 ! Formal parameters:
; 0896 ! Address of global symbol table entry
; 0897 !
; 0898 ! Implicit inputs:
; 0899 ! None
; 0900 !
; 0901 ! Implicit outputs:
; 0902 ! None
; 0903 !
; 0904 ! Routine value:
; 0905 ! None
; 0906 !
; 0907 ! Side effects:
; 0908 ! None
; 0909 !
; 0910 !--
; 0911
; 0912 BEGIN
; 0913 EXTERNAL REGISTER Z=0;
; 0914 CASE .GS[GST_CLS] FROM GST_CLS_CMD TO GST_CLS_SYN OF
; 0915 SET
; 0916 [GST_CLS_CMD]: RETMEM( .GS[GST_COD] + .GS[GST_CNS] + .GS[GST_SML]*STE_LEN,
; 0917 .GS[GST_TXT],PCTXFR);
; 0918 [GST_CLS_PRC,
; 0919 GST_CLS_FCN]: RETMEM( .GS[GST_COD] + .GS[GST_PCT] + .GS[GST_CNS]
; 0920 + .GS[GST_SML]*STE_LEN,
; 0921 .GS[GST_TXT], PCTXFR);
; 0922 [GST_CLS_VAR]: IF .GS[GST_TYP] EQL GST_TYP_STR
; 0923 THEN
; 0924 BEGIN
; 0925 LOCAL
; 0926 STR: STR_VAL; ! String value
; 0927 STR = .GS[GST_VAL];
; 0928 GS[GST_VAL] = 0;
; 0929 IF .STR NEQ 0
; 0930 THEN
; 0931 RETMEM((.STR[STV_LEN]+5)/5, .STR[STV_ADR], PCTXFR)
; 0932 END;
; 0933 [GST_CLS_SYN]: IF .GS[GST_PLN] NEQ 0 THEN RETMEM( (.GS[GST_PLN]+4)/5,
; 0934 .GS[GST_TXT], PCTXFR)
; 0935 TES
; 0936 END;
FREESTG:PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC1 ; GS,AC1
LDB AC1,C.4 ; AC1,[POINT 3,0(AC14),4] <31,3>
JRST L.62(AC1) ; L.62(AC1)
L.62: JRST L.63 ; L.63
JRST L.64 ; L.64
JRST L.66 ; L.66
JRST L.64 ; L.64
JRST L.67 ; L.67
L.63: LDB AC4,C.29 ; AC4,[POINT 12,1(GS),35] <0,12>
JRST L.65 ; L.65
L.64: LDB AC4,C.29 ; AC4,[POINT 12,1(GS),35] <0,12>
LDB AC1,C.30 ; AC1,[POINT 4,0(GS),9] <26,4>
ADD AC4,AC1 ; AC4,AC1
L.65: LDB AC1,C.31 ; AC1,[POINT 12,1(GS),23] <12,12>
ADD AC4,AC1 ; AC4,AC1
LDB AC1,C.32 ; AC1,[POINT 12,1(GS),11] <24,12>
IMULI AC1,2 ; AC1,2
ADD AC4,AC1 ; AC4,AC1
MOVE AC1,AC4 ; AC1,AC4
JRST L.68 ; L.68
L.66: LDB AC1,C.33 ; AC1,[POINT 1,0(GS),5] <30,1>
CAIE AC1,1 ; AC1,1
JRST L.70 ; L.70
MOVE AC4,1(AC14) ; STR,1(GS)
SETZM 1(AC14) ; 1(GS)
JUMPE AC4,L.70 ; STR,L.70
HLRZ AC1,AC4 ; AC1,STR
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,0(AC4) ; AC2,0(STR)
JRST L.69 ; L.69
L.67: LDB AC1,C.34 ; AC1,[POINT 9,1(GS),35] <0,9>
JUMPE AC1,L.70 ; AC1,L.70
ADDI AC1,4 ; AC1,4
IDIVI AC1,5 ; AC1,5
L.68: HRRZ AC2,0(AC14) ; AC2,0(GS)
L.69: MOVEI AC3,PCTXFR ; AC3,PCTXFR
PUSHJ SP,RETMEM ; SP,RETMEM
L.70: POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
C.29: POINT 12,1(AC14),35 ; 12,1(GS),35
C.30: POINT 4,0(AC14),9 ; 4,0(GS),9
C.31: POINT 12,1(AC14),23 ; 12,1(GS),23
C.32: POINT 12,1(AC14),11 ; 12,1(GS),11
C.33: POINT 1,0(AC14),5 ; 1,0(GS),5
C.34: POINT 9,1(AC14),35 ; 9,1(GS),35
; Routine Size: 47 words
; 0937
; 0938 GLOBAL ROUTINE PCIINF = ! Entry point for INFORMATION PCL
; 0939
; 0940 !++
; 0941 ! Functional description:
; 0942 ! Generate a string containing a line for each object class,
; 0943 ! containing the name of each object in the class. Return
; 0944 ! the string, in a form suitable for display by UTYPE.
; 0945 !
; 0946 ! Formal parameters:
; 0947 ! None
; 0948 !
; 0949 ! Implicit inputs:
; 0950 ! Global symbol table
; 0951 !
; 0952 ! Implicit outputs:
; 0953 ! String buffer CSBUF
; 0954 !
; 0955 ! Routine value:
; 0956 ! Address of string buffer, or zero
; 0957 !
; 0958 ! Side effects:
; 0959 ! None
; 0960 !
; 0961 !--
; 0962
; 0963 BEGIN
; 0964 EXTERNAL REGISTER Z=0;
; 0965 LOCAL
; 0966 PTR, ! Character pointer
; 0967 IPTR,
; 0968 BUF: STR_VAL, ! Buffer
; 0969 WIDTH, ! Terminal width
; 0970 LEN, ! Length of current line
; 0971 ENTRY: VECTOR[10], ! A single entry
; 0972 EPTR, ! Pointer in entry
; 0973 ELEN, ! Length of entry
; 0974 CNT, ! Count of names on this line
; 0975 CHR; ! Character
; 0976
; 0977 BEGIN
; 0978 REGISTER R1=1,R2=2,R3=3;
; 0979 R1 = .COJFN;
; 0980 R2 = $MORLW;
; 0981 JSYS(-1,MTOPR,R1,R2,R3);
; 0982 WIDTH = .R3;
; 0983 IF .WIDTH GEQ 10000 ! In case foonly PDS...
; 0984 THEN
; 0985 WIDTH = 0;
; 0986 END;
; 0987 BUF = .CSBUFP;
; 0988 BUF = .BUF[STV_ADR] + 1;
; 0989 PTR = BYTPTR(.BUF);
; 0990 LEN = 0;
; 0991 INCR I FROM GST_CLS_CMD TO GST_CLS_SYN DO
; 0992 BEGIN
; 0993 CNT = 0;
; 0994 INCR J FROM 0 TO .PCLGST-1 DO
; 0995 IF .PCGBST[.J,GST_VLD] NEQ 0 AND .PCGBST[.J,GST_CLS] EQL .I
; 0996 THEN
; 0997 BEGIN
; 0998 IF .CNT EQL 0
; 0999 THEN
; 1000 BEGIN
; 1001 IPTR = (CASE .I FROM GST_CLS_CMD TO GST_CLS_SYN OF
; 1002 SET
; 1003 [GST_CLS_CMD]: CH$PTR(UPLIT(%ASCIZ ' Commands:'));
; 1004 [GST_CLS_PRC]: CH$PTR(UPLIT(%ASCIZ ' Procedures:'));
; 1005 [GST_CLS_FCN]: CH$PTR(UPLIT(%ASCIZ ' Typed Procedures:'));
; 1006 [GST_CLS_VAR]: CH$PTR(UPLIT(%ASCIZ ' Variables:'));
; 1007 [GST_CLS_SYN]: CH$PTR(UPLIT(%ASCIZ ' Command name manipulations:'))
; 1008 TES);
; 1009 WHILE
; 1010 (CHR=CH$RCHAR_A(IPTR)) NEQ 0
; 1011 DO
; 1012 BEGIN
; 1013 CH$WCHAR_A(.CHR,PTR);
; 1014 LEN = .LEN + 1
; 1015 END
; 1016 END;
; 1017 EPTR = BYTPTR(ENTRY);
; 1018 ELEN = 1;
; 1019 CH$WCHAR_A(%C' ',EPTR);
; 1020 IF .CNT GEQ 1
; 1021 THEN
; 1022 BEGIN
; 1023 CH$WCHAR_A(%C',',PTR);
; 1024 LEN = .LEN + 1
; 1025 END;
; 1026 CNT = .CNT + 1;
; 1027 IF .I EQL GST_CLS_FCN OR .I EQL GST_CLS_VAR
; 1028 THEN
; 1029 BEGIN
; 1030 IF .PCGBST[.J,GST_TYP] EQL GST_TYP_INT
; 1031 THEN
; 1032 IPTR = CH$PTR(UPLIT(%ASCIZ 'Integer '))
; 1033 ELSE
; 1034 IPTR = CH$PTR(UPLIT(%ASCIZ 'String '));
; 1035 WHILE
; 1036 (CHR=CH$RCHAR_A(IPTR)) NEQ 0
; 1037 DO
; 1038 BEGIN
; 1039 CH$WCHAR_A(.CHR,EPTR);
; 1040 ELEN = .ELEN + 1
; 1041 END
; 1042 END;
; 1043 IF .I EQL GST_CLS_FCN
; 1044 THEN
; 1045 BEGIN
; 1046 IPTR = CH$PTR(UPLIT(%ASCIZ 'Procedure '));
; 1047 WHILE
; 1048 (CHR=CH$RCHAR_A(IPTR)) NEQ 0
; 1049 DO
; 1050 BEGIN
; 1051 CH$WCHAR_A(.CHR,EPTR);
; 1052 ELEN = .ELEN + 1
; 1053 END
; 1054 END
; 1055 ELSE
; 1056 IF .I EQL GST_CLS_SYN
; 1057 THEN
; 1058 BEGIN
; 1059 IF .PCGBST[.J,GST_PLN] NEQ 0
; 1060 THEN
; 1061 IPTR = CH$PTR(UPLIT(%ASCIZ 'Synonym '))
; 1062 ELSE
; 1063 IPTR = CH$PTR(UPLIT(%ASCIZ 'Undeclare Original '));
; 1064 WHILE
; 1065 (CHR=CH$RCHAR_A(IPTR)) NEQ 0
; 1066 DO
; 1067 BEGIN
; 1068 CH$WCHAR_A(.CHR,EPTR);
; 1069 ELEN = .ELEN + 1
; 1070 END
; 1071 END;
; 1072 IPTR = BYTPTR(.PCGBST[.J,GST_NMA]);
; 1073 WHILE
; 1074 (CHR = CH$RCHAR_A(IPTR)) NEQ 0
; 1075 DO
; 1076 BEGIN
; 1077 CH$WCHAR_A(.CHR, EPTR);
; 1078 ELEN = .ELEN + 1
; 1079 END;
; 1080 IF .PCGBST[.J,GST_PSV]
; 1081 THEN
; 1082 BEGIN
; 1083 CH$WCHAR_A(%C'$', EPTR);
; 1084 ELEN = .ELEN + 1;
; 1085 IF .PCGBST[.J,GST_SPR]
; 1086 THEN
; 1087 BEGIN
; 1088 CH$WCHAR_A(%C'*', EPTR);
; 1089 ELEN = .ELEN + 1
; 1090 END
; 1091 END;
; 1092 IF .I EQL GST_CLS_SYN AND .PCGBST[.J,GST_PLN] NEQ 0
; 1093 THEN
; 1094 BEGIN
; 1095 CH$WCHAR_A(%C'=', EPTR);
; 1096 ELEN = .ELEN + 1;
; 1097 IPTR = BYTPTR(.PCGBST[.J,GST_TXT]);
; 1098 WHILE
; 1099 (CHR = CH$RCHAR_A(IPTR)) NEQ 0
; 1100 DO
; 1101 BEGIN
; 1102 CH$WCHAR_A(.CHR, EPTR);
; 1103 ELEN = .ELEN + 1
; 1104 END
; 1105 END;
; 1106 IF .LEN + .ELEN GEQ .WIDTH
; 1107 THEN
; 1108 BEGIN
; 1109 CH$WCHAR_A(%C'%',PTR);
; 1110 CH$WCHAR_A(%C'_',PTR);
; 1111 CH$WCHAR_A(%C' ',PTR);
; 1112 LEN = 1
; 1113 END;
; 1114 CH$WCHAR_A(0,EPTR);
; 1115 EPTR = BYTPTR(ENTRY);
; 1116 WHILE (CHR=CH$RCHAR_A(EPTR)) NEQ 0 DO CH$WCHAR_A(.CHR,PTR);
; 1117 LEN = .LEN + .ELEN
; 1118 END;
; 1119 IF .CNT NEQ 0
; 1120 THEN
; 1121 BEGIN
; 1122 CH$WCHAR_A(%C'%',PTR);
; 1123 CH$WCHAR_A(%C'_',PTR);
; 1124 LEN = 0
; 1125 END
; 1126 END;
; 1127 IF .PTR NEQ BYTPTR(.BUF)
; 1128 THEN
; 1129 BEGIN
; 1130 CH$WCHAR_A($CHNUL,PTR);
; 1131 .BUF
; 1132 END
; 1133 ELSE
; 1134 0
; 1135 END;
P.AAC: BYTE (7)" ","C","o","m","m" ; Comm
BYTE (7)"a","n","d","s",":" ; ands:
BYTE (7)000,000,000,000,000
P.AAD: BYTE (7)" ","P","r","o","c" ; Proc
BYTE (7)"e","d","u","r","e" ; edure
BYTE (7)"s",":",000,000,000 ; s:
P.AAE: BYTE (7)" ","T","y","p","e" ; Type
BYTE (7)"d"," ","P","r","o" ; d Pro
BYTE (7)"c","e","d","u","r" ; cedur
BYTE (7)"e","s",":",000,000 ; es:
P.AAF: BYTE (7)" ","V","a","r","i" ; Vari
BYTE (7)"a","b","l","e","s" ; ables
BYTE (7)":",000,000,000,000 ; :
P.AAG: BYTE (7)" ","C","o","m","m" ; Comm
BYTE (7)"a","n","d"," ","n" ; and n
BYTE (7)"a","m","e"," ","m" ; ame m
BYTE (7)"a","n","i","p","u" ; anipu
BYTE (7)"l","a","t","i","o" ; latio
BYTE (7)"n","s",":",000,000 ; ns:
P.AAH: BYTE (7)"I","n","t","e","g" ; Integ
BYTE (7)"e","r"," ",000,000 ; er
P.AAI: BYTE (7)"S","t","r","i","n" ; Strin
BYTE (7)"g"," ",000,000,000 ; g
P.AAJ: BYTE (7)"P","r","o","c","e" ; Proce
BYTE (7)"d","u","r","e"," " ; dure
BYTE (7)000,000,000,000,000
P.AAK: BYTE (7)"S","y","n","o","n" ; Synon
BYTE (7)"y","m"," ",000,000 ; ym
P.AAL: BYTE (7)"U","n","d","e","c" ; Undec
BYTE (7)"l","a","r","e"," " ; lare
BYTE (7)"O","r","i","g","i" ; Origi
BYTE (7)"n","a","l"," ",000 ; nal
PCIINF::PUSH SP,AC7 ; SP,AC7
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,14 ; SP,14
MOVE AC1,COJFN ; R1,COJFN
MOVEI AC2,30 ; R2,30
JSYS 77 ; 77
JUMP 16,L.71 ; 16,L.71
L.71: MOVEM AC3,0(SP) ; R3,WIDTH
MOVEI AC1,23420 ; AC1,23420
CAMG AC1,0(SP) ; AC1,WIDTH
SETZM 0(SP) ; WIDTH
MOVE AC1,CSBUFP ; BUF,CSBUFP
MOVEI AC1,0(AC1) ; BUF,0(BUF)
AOS AC2,AC1 ; HLF,BUF
HRLI AC2,-337100 ; HLF,-337100
MOVE AC11,AC2 ; PTR,HLF
SETZB AC16,AC14 ; LEN,I
L.72: SETZ AC10, ; CNT,
MOVE AC2,PCLGST ; AC2,PCLGST
MOVEM AC2,-1(SP) ; AC2,-1(SP)
SETO AC13, ; J,
JRST L.100 ; L.100
L.73: MOVE AC2,AC13 ; AC2,J
IMULI AC2,3 ; AC2,3
SKIPN PCGBST(AC2) ; PCGBST(AC2)
JRST L.100 ; L.100
LDB AC7,C.35 ; AC7,[POINT 3,PCGBST(AC2),4] <31,3>
CAME AC7,AC14 ; AC7,I
JRST L.100 ; L.100
JUMPN AC10,L.81 ; CNT,L.81
JRST L.74(AC14) ; L.74(I)
L.74: JRST L.75 ; L.75
JRST L.76 ; L.76
JRST L.78 ; L.78
JRST L.77 ; L.77
JRST L.79 ; L.79
L.75: MOVE AC4,C.38 ; IPTR,[POINT 7,P.AAC-1,34] <1,7>
JRST L.80 ; L.80
L.76: MOVE AC4,C.39 ; IPTR,[POINT 7,P.AAD-1,34] <1,7>
JRST L.80 ; L.80
L.77: MOVE AC4,C.40 ; IPTR,[POINT 7,P.AAE-1,34] <1,7>
JRST L.80 ; L.80
L.78: SKIPA AC4,C.41 ; IPTR,[POINT 7,P.AAF-1,34] <1,7>
L.79: MOVE AC4,C.42 ; IPTR,[POINT 7,P.AAG-1,34] <1,7>
L.80: ILDB AC3,AC4 ; CHR,IPTR
JUMPE AC3,L.81 ; CHR,L.81
IDPB AC3,AC11 ; CHR,PTR
AOJA AC16,L.80 ; LEN,L.80
L.81: MOVEI AC2,-13(SP) ; HLF,ENTRY
HRLI AC2,-337100 ; HLF,-337100
MOVE AC5,AC2 ; EPTR,HLF
MOVEI AC12,1 ; ELEN,1
MOVEI AC2,40 ; AC2,40
IDPB AC2,AC5 ; AC2,EPTR
JUMPLE AC10,L.82 ; CNT,L.82
MOVEI AC2,54 ; AC2,54
IDPB AC2,AC11 ; AC2,PTR
ADDI AC16,1 ; LEN,1
L.82: ADDI AC10,1 ; CNT,1
CAIN AC14,3 ; I,3
JRST L.83 ; L.83
CAIE AC14,2 ; I,2
JRST L.86 ; L.86
L.83: MOVE AC2,AC13 ; AC2,J
IMULI AC2,3 ; AC2,3
LDB AC7,C.36 ; AC7,[POINT 1,PCGBST(AC2),5] <30,1>
JUMPN AC7,L.84 ; AC7,L.84
SKIPA AC4,C.43 ; IPTR,[POINT 7,P.AAH-1,34] <1,7>
L.84: MOVE AC4,C.44 ; IPTR,[POINT 7,P.AAI-1,34] <1,7>
L.85: ILDB AC3,AC4 ; CHR,IPTR
JUMPE AC3,L.86 ; CHR,L.86
IDPB AC3,AC5 ; CHR,EPTR
AOJA AC12,L.85 ; ELEN,L.85
L.86: CAIE AC14,3 ; I,3
JRST L.88 ; L.88
MOVE AC4,C.45 ; IPTR,[POINT 7,P.AAJ-1,34] <1,7>
L.87: ILDB AC3,AC4 ; CHR,IPTR
JUMPE AC3,L.91 ; CHR,L.91
IDPB AC3,AC5 ; CHR,EPTR
AOJA AC12,L.87 ; ELEN,L.87
L.88: CAIE AC14,4 ; I,4
JRST L.91 ; L.91
MOVE AC2,AC13 ; AC2,J
IMULI AC2,3 ; AC2,3
LDB AC7,C.37 ; AC7,[POINT 9,PCGBST+1(AC2),35] <0,9>
JUMPE AC7,L.89 ; AC7,L.89
SKIPA AC4,C.46 ; IPTR,[POINT 7,P.AAK-1,34] <1,7>
L.89: MOVE AC4,C.47 ; IPTR,[POINT 7,P.AAL-1,34] <1,7>
L.90: ILDB AC3,AC4 ; CHR,IPTR
JUMPE AC3,L.91 ; CHR,L.91
IDPB AC3,AC5 ; CHR,EPTR
AOJA AC12,L.90 ; ELEN,L.90
L.91: MOVE AC2,AC13 ; AC2,J
IMULI AC2,3 ; AC2,3
HRRZ AC2,PCGBST+2(AC2) ; HLF,PCGBST+2(AC2)
HRLI AC2,-337100 ; HLF,-337100
MOVE AC4,AC2 ; IPTR,HLF
L.92: ILDB AC3,AC4 ; CHR,IPTR
JUMPE AC3,L.93 ; CHR,L.93
IDPB AC3,AC5 ; CHR,EPTR
AOJA AC12,L.92 ; ELEN,L.92
L.93: MOVE AC2,AC13 ; AC2,J
IMULI AC2,3 ; AC2,3
SKIPL PCGBST(AC2) ; PCGBST(AC2)
JRST L.94 ; L.94
MOVEI AC2,44 ; AC2,44
IDPB AC2,AC5 ; AC2,EPTR
ADDI AC12,1 ; ELEN,1
MOVE AC2,AC13 ; AC2,J
IMULI AC2,3 ; AC2,3
MOVSI AC7,200000 ; AC7,200000
TDNN AC7,PCGBST(AC2) ; AC7,PCGBST(AC2)
JRST L.94 ; L.94
MOVEI AC2,52 ; AC2,52
IDPB AC2,AC5 ; AC2,EPTR
ADDI AC12,1 ; ELEN,1
L.94: CAIE AC14,4 ; I,4
JRST L.96 ; L.96
MOVE AC2,AC13 ; AC2,J
IMULI AC2,3 ; AC2,3
LDB AC7,C.37 ; AC7,[POINT 9,PCGBST+1(AC2),35] <0,9>
JUMPE AC7,L.96 ; AC7,L.96
MOVEI AC2,75 ; AC2,75
IDPB AC2,AC5 ; AC2,EPTR
ADDI AC12,1 ; ELEN,1
MOVE AC2,AC13 ; AC2,J
IMULI AC2,3 ; AC2,3
HRRZ AC2,PCGBST(AC2) ; HLF,PCGBST(AC2)
HRLI AC2,-337100 ; HLF,-337100
MOVE AC4,AC2 ; IPTR,HLF
L.95: ILDB AC3,AC4 ; CHR,IPTR
JUMPE AC3,L.96 ; CHR,L.96
IDPB AC3,AC5 ; CHR,EPTR
AOJA AC12,L.95 ; ELEN,L.95
L.96: MOVE AC2,AC16 ; AC2,LEN
ADD AC2,AC12 ; AC2,ELEN
CAMGE AC2,0(SP) ; AC2,WIDTH
JRST L.97 ; L.97
MOVEI AC2,45 ; AC2,45
IDPB AC2,AC11 ; AC2,PTR
MOVEI AC2,137 ; AC2,137
IDPB AC2,AC11 ; AC2,PTR
MOVEI AC2,40 ; AC2,40
IDPB AC2,AC11 ; AC2,PTR
MOVEI AC16,1 ; LEN,1
L.97: SETZ AC2, ; AC2,
IDPB AC2,AC5 ; AC2,EPTR
MOVEI AC2,-13(SP) ; HLF,ENTRY
HRLI AC2,-337100 ; HLF,-337100
MOVE AC5,AC2 ; EPTR,HLF
L.98: ILDB AC3,AC5 ; CHR,EPTR
JUMPE AC3,L.99 ; CHR,L.99
IDPB AC3,AC11 ; CHR,PTR
JRST L.98 ; L.98
L.99: ADD AC16,AC12 ; LEN,ELEN
L.100: ADDI AC13,1 ; J,1
CAMGE AC13,-1(SP) ; J,-1(SP)
JRST L.73 ; L.73
JUMPE AC10,L.101 ; CNT,L.101
MOVEI AC2,45 ; AC2,45
IDPB AC2,AC11 ; AC2,PTR
MOVEI AC2,137 ; AC2,137
IDPB AC2,AC11 ; AC2,PTR
SETZ AC16, ; LEN,
L.101: ADDI AC14,1 ; I,1
CAIG AC14,4 ; I,4
JRST L.72 ; L.72
MOVE AC2,AC1 ; HLF,BUF
HRLI AC2,-337100 ; HLF,-337100
CAMN AC11,AC2 ; PTR,HLF
JRST L.102 ; L.102
SETZ AC2, ; AC2,
IDPB AC2,AC11 ; AC2,PTR
JRST L.103 ; L.103
L.102: SETZ AC1, ; AC1,
L.103: ADJSP SP,-14 ; SP,-14
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
POP SP,AC7 ; SP,AC7
POPJ SP, ; SP,
C.35: POINT 3,PCGBST(AC2),4 ; 3,PCGBST(AC2),4
C.36: POINT 1,PCGBST(AC2),5 ; 1,PCGBST(AC2),5
C.37: POINT 9,PCGBST+1(AC2),35 ; 9,PCGBST+1(AC2),35
C.38: POINT 7,P.AAC-1,34 ; 7,P.AAC-1,34
C.39: POINT 7,P.AAD-1,34 ; 7,P.AAD-1,34
C.40: POINT 7,P.AAE-1,34 ; 7,P.AAE-1,34
C.41: POINT 7,P.AAF-1,34 ; 7,P.AAF-1,34
C.42: POINT 7,P.AAG-1,34 ; 7,P.AAG-1,34
C.43: POINT 7,P.AAH-1,34 ; 7,P.AAH-1,34
C.44: POINT 7,P.AAI-1,34 ; 7,P.AAI-1,34
C.45: POINT 7,P.AAJ-1,34 ; 7,P.AAJ-1,34
C.46: POINT 7,P.AAK-1,34 ; 7,P.AAK-1,34
C.47: POINT 7,P.AAL-1,34 ; 7,P.AAL-1,34
; Routine Size: 200 words
; 1136
; 1137 GLOBAL ROUTINE PCISGS(NAME,TYPE,VALUE) = ! Entry point for SET VARIABLE
; 1138
; 1139 !++
; 1140 ! Functional description:
; 1141 ! Perform Set Variable command, depositing given datum in
; 1142 ! global variable. If datum is a string, copy it to the
; 1143 ! text region.
; 1144 !
; 1145 ! Formal parameters:
; 1146 ! Pointer to ASCIZ string of (unfolded) variable name
; 1147 ! Expected variable type: -1=string, 0=integer
; 1148 ! Datum to store
; 1149 !
; 1150 ! Implicit inputs:
; 1151 ! Global symbol table
; 1152 !
; 1153 ! Implicit outputs:
; 1154 ! Global symbol table, text region
; 1155 !
; 1156 ! Routine value:
; 1157 ! +1 if successful, 0 if no such variable, -1 if wrong type
; 1158 !
; 1159 ! Side effects:
; 1160 ! None
; 1161 !
; 1162 !--
; 1163
; 1164 BEGIN
; 1165 EXTERNAL REGISTER Z=0;
; 1166 MAP
; 1167 NAME: STR_VAL,
; 1168 VALUE: STR_VAL;
; 1169 LOCAL
; 1170 PTR, ! String pointer
; 1171 CNT, ! Counter
; 1172 CHR, ! Character
; 1173 SYM: STR_VAL, ! String value of symbol
; 1174 GST: REF GST_BLK; ! GST address of symbol
; 1175 PTR = .NAME;
; 1176 CNT = -1;
; 1177 DO
; 1178 BEGIN
; 1179 CHR = CH$RCHAR(.PTR);
; 1180 IF .CHR GEQ %C'a' AND .CHR LEQ %C'z' THEN CHR = .CHR - %C'a' + %C'A';
; 1181 CH$WCHAR_A(.CHR, PTR);
; 1182 CNT = .CNT + 1
; 1183 END
; 1184 WHILE
; 1185 .CHR NEQ 0;
; 1186 SYM[STV_LEN] = .CNT;
; 1187 SYM[STV_ADR] = .NAME[STV_ADR];
; 1188 GST = PCIFGS(.SYM,0);
; 1189 IF .GST LEQ 0 THEN RETURN 0;
; 1190 IF .GST[GST_CLS] NEQ GST_CLS_VAR THEN RETURN 0;
; 1191 CASE .GST[GST_TYP] FROM GST_TYP_INT TO GST_TYP_STR OF
; 1192 SET
; 1193 [GST_TYP_INT]: BEGIN
; 1194 IF .TYPE NEQ 0 THEN RETURN -1;
; 1195 GST[GST_VAL] = .VALUE
; 1196 END;
; 1197 [GST_TYP_STR]: BEGIN
; 1198 IF .TYPE EQL 0 THEN RETURN -1;
; 1199 IF .GST[GST_VAL] NEQ 0
; 1200 THEN
; 1201 BEGIN
; 1202 SYM = .GST[GST_VAL];
; 1203 RETMEM((.SYM[STV_LEN]+5)/5, .SYM[STV_ADR], PCTXFR)
; 1204 END;
; 1205 IF .VALUE[STV_LEN] EQL 0
; 1206 THEN
; 1207 GST[GST_VAL] = 0
; 1208 ELSE
; 1209 BEGIN
; 1210 SYM = PCMGMM((.VALUE[STV_LEN]+5)/5, PCTXFR);
; 1211 CH$MOVE(.VALUE[STV_LEN]+1,
; 1212 BYTPTR(.VALUE[STV_ADR]),BYTPTR(.SYM));
; 1213 SYM[STV_LEN] = .VALUE[STV_LEN];
; 1214 GST[GST_VAL] = .SYM
; 1215 END
; 1216 END;
; 1217 TES;
; 1218 1
; 1219 END;
PCISGS::PUSH SP,AC11 ; SP,AC11
PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC11,AC3 ; VALUE,AC3
MOVE AC14,AC2 ; TYPE,AC2
MOVE AC4,AC1 ; PTR,NAME
SETO AC5, ; CNT,
L.104: MOVE AC3,AC4 ; AC3,PTR
ILDB AC2,AC3 ; CHR,AC3
CAIL AC2,141 ; CHR,141
CAILE AC2,172 ; CHR,172
JRST L.105 ; L.105
SUBI AC2,40 ; CHR,40
L.105: IDPB AC2,AC4 ; CHR,PTR
ADDI AC5,1 ; CNT,1
JUMPN AC2,L.104 ; CHR,L.104
HRL AC12,AC5 ; SYM,CNT
HRR AC12,AC1 ; SYM,NAME
MOVE AC1,AC12 ; AC1,SYM
SETZ AC2, ; AC2,
PUSHJ SP,PCIFGS ; SP,PCIFGS
JUMPLE AC1,L.106 ; GST,L.106
LDB AC2,C.12 ; AC2,[POINT 3,0(AC1),4] <31,3>
CAIN AC2,2 ; AC2,2
JRST L.107 ; L.107
L.106: SETZ AC1, ; AC1,
JRST L.116 ; L.116
L.107: MOVE AC13,AC1 ; AC13,GST
ADDI AC13,1 ; AC13,1
LDB AC1,C.48 ; AC1,[POINT 1,0(GST),5] <30,1>
JRST L.108(AC1) ; L.108(AC1)
L.108: JRST L.109 ; L.109
JRST L.110 ; L.110
L.109: JUMPN AC14,L.111 ; TYPE,L.111
MOVEM AC11,0(AC13) ; VALUE,0(AC13)
JRST L.115 ; L.115
L.110: JUMPN AC14,L.112 ; TYPE,L.112
L.111: SETO AC1, ; AC1,
JRST L.116 ; L.116
L.112: MOVE AC1,0(AC13) ; AC1,0(AC13)
JUMPE AC1,L.113 ; AC1,L.113
MOVE AC12,AC1 ; SYM,AC1
HLRZ AC1,AC12 ; AC1,SYM
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,0(AC12) ; AC2,0(SYM)
MOVEI AC3,PCTXFR ; AC3,PCTXFR
PUSHJ SP,RETMEM ; SP,RETMEM
L.113: HLRZ AC14,AC11 ; AC14,VALUE
JUMPN AC14,L.114 ; AC14,L.114
SETZM 0(AC13) ; 0(AC13)
JRST L.115 ; L.115
L.114: MOVE AC1,AC14 ; AC1,AC14
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
MOVEI AC2,PCTXFR ; AC2,PCTXFR
PUSHJ SP,PCMGMM ; SP,PCMGMM
MOVE AC12,AC1 ; SYM,AC1
MOVE AC1,AC14 ; AC1,AC14
ADDI AC1,1 ; AC1,1
MOVEI AC2,0(AC11) ; HLF,0(VALUE)
HRLI AC2,-337100 ; HLF,-337100
MOVE AC5,AC12 ; HLF,SYM
HRLI AC5,-337100 ; HLF,-337100
MOVE AC4,AC1 ; AC4,AC1
EXTEND AC1,C.8 ; AC1,[MOVSLJ ]
JFCL ;
HRL AC12,AC14 ; SYM,AC14
MOVEM AC12,0(AC13) ; SYM,0(AC13)
L.115: MOVEI AC1,1 ; AC1,1
L.116: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POP SP,AC11 ; SP,AC11
POPJ SP, ; SP,
C.48: POINT 1,0(AC1),5 ; 1,0(GST),5
; Routine Size: 77 words
; 1220
; 1221 GLOBAL ROUTINE PCIDGS(NAME) = ! Entry point for INFORMATION VARIABLE
; 1222
; 1223 !++
; 1224 ! Functional description:
; 1225 ! Get value of global variable and return it in printable form.
; 1226 !
; 1227 ! Formal parameters:
; 1228 ! Pointer to ASCIZ string of unfolded variable name
; 1229 !
; 1230 ! Implicit inputs:
; 1231 ! Global symbol table
; 1232 !
; 1233 ! Implicit outputs:
; 1234 ! CSBUF
; 1235 !
; 1236 ! Routine value:
; 1237 ! Address of ASCIZ string containing value, or -1 if no such symbol
; 1238 !
; 1239 ! Side effects:
; 1240 ! None
; 1241 !
; 1242 !--
; 1243
; 1244 BEGIN
; 1245 EXTERNAL REGISTER Z=0;
; 1246 MAP
; 1247 NAME: STR_VAL;
; 1248 LOCAL
; 1249 PTR, ! String pointer
; 1250 CNT, ! Counter
; 1251 CHR, ! Character
; 1252 STR: STR_VAL, ! Stringvalue
; 1253 BUF: STR_VAL, ! Pointer to string being returned
; 1254 GST: REF GST_BLK; ! GST entry of variable
; 1255 PTR = .NAME;
; 1256 CNT = -1;
; 1257 DO
; 1258 (CHR=CH$RCHAR(.PTR);
; 1259 IF .CHR GEQ %C'a' AND .CHR LEQ %C'z' THEN CHR = .CHR AND %O'137';
; 1260 CH$WCHAR_A(.CHR,PTR);
; 1261 CNT=.CNT+1)
; 1262 WHILE
; 1263 .CHR NEQ 0;
; 1264 STR[STV_LEN] = .CNT;
; 1265 STR[STV_ADR] = .NAME[STV_ADR];
; 1266 GST = PCIFGS(.STR,0);
; 1267 IF .GST LEQ 0 THEN RETURN -1;
; 1268 IF .GST[GST_CLS] NEQ GST_CLS_VAR THEN RETURN -1;
; 1269 BUF = .CSBUFP;
; 1270 BUF = .BUF[STV_ADR] + 1;
; 1271 PTR = BYTPTR(.BUF);
; 1272 IF .GST[GST_TYP] EQL GST_TYP_INT
; 1273 THEN
; 1274 BEGIN
; 1275 PTR = PCMITS(.GST[GST_VAL],.PTR);
; 1276 CH$WCHAR($CHNUL,.PTR)
; 1277 END
; 1278 ELSE
; 1279 IF .GST[GST_VAL] NEQ 0
; 1280 THEN
; 1281 BEGIN
; 1282 STR = .GST[GST_VAL];
; 1283 CH$MOVE(.STR[STV_LEN]+1,BYTPTR(.STR[STV_ADR]),.PTR)
; 1284 END
; 1285 ELSE
; 1286 CH$WCHAR($CHNUL,.PTR);
; 1287 .BUF
; 1288 END;
PCIDGS::PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC12,AC1 ; PTR,NAME
SETO AC4, ; CNT,
L.117: MOVE AC2,AC12 ; AC2,PTR
ILDB AC3,AC2 ; CHR,AC2
CAIL AC3,141 ; CHR,141
CAILE AC3,172 ; CHR,172
JRST L.118 ; L.118
ANDI AC3,137 ; CHR,137
L.118: IDPB AC3,AC12 ; CHR,PTR
ADDI AC4,1 ; CNT,1
JUMPN AC3,L.117 ; CHR,L.117
HRL AC14,AC4 ; STR,CNT
HRR AC14,AC1 ; STR,NAME
MOVE AC1,AC14 ; AC1,STR
SETZ AC2, ; AC2,
PUSHJ SP,PCIFGS ; SP,PCIFGS
JUMPLE AC1,L.119 ; GST,L.119
LDB AC2,C.12 ; AC2,[POINT 3,0(AC1),4] <31,3>
CAIN AC2,2 ; AC2,2
JRST L.120 ; L.120
L.119: SETO AC1, ; AC1,
JRST L.124 ; L.124
L.120: MOVE AC13,CSBUFP ; BUF,CSBUFP
MOVEI AC13,0(AC13) ; BUF,0(BUF)
AOS AC2,AC13 ; HLF,BUF
HRLI AC2,-337100 ; HLF,-337100
MOVE AC12,AC2 ; PTR,HLF
MOVE AC3,AC1 ; AC3,GST
ADDI AC3,1 ; AC3,1
LDB AC2,C.48 ; AC2,[POINT 1,0(AC1),5] <30,1>
JUMPN AC2,L.121 ; AC2,L.121
MOVE AC1,0(AC3) ; AC1,0(AC3)
MOVE AC2,AC12 ; AC2,PTR
PUSHJ SP,PCMITS ; SP,PCMITS
MOVE AC12,AC1 ; PTR,AC1
JRST L.122 ; L.122
L.121: MOVE AC1,0(AC3) ; AC1,0(AC3)
JUMPE AC1,L.122 ; AC1,L.122
MOVE AC14,AC1 ; STR,AC1
HLRZ AC1,AC14 ; AC1,STR
ADDI AC1,1 ; AC1,1
MOVEI AC2,0(AC14) ; HLF,0(STR)
HRLI AC2,-337100 ; HLF,-337100
MOVE AC4,AC1 ; AC4,AC1
MOVE AC5,AC12 ; AC5,PTR
EXTEND AC1,C.8 ; AC1,[MOVSLJ ]
JFCL ;
JRST L.123 ; L.123
L.122: SETZ AC1, ; AC1,
MOVE AC2,AC12 ; AC2,PTR
IDPB AC1,AC2 ; AC1,AC2
L.123: MOVE AC1,AC13 ; AC1,BUF
L.124: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 59 words
; 1289
; 1290 GLOBAL ROUTINE PCIPRS(FLDDB,OPTFLG,PMTSTR) = ! Do Parse
; 1291
; 1292 !++
; 1293 ! Functional description:
; 1294 ! Parses a field from the original command line which invoked
; 1295 ! the command procedure, according to the FLDDB chain provided
; 1296 ! by the user's procedure. I call the macro-interface COMND%
; 1297 ! routine to do the COMND% in the proper context. If the parse
; 1298 ! succeeds, I save appropriate information in standard variables
; 1299 ! so the user can get things like number typed, keyword entered,
; 1300 ! etc., by using further system calls. I return the real address
; 1301 ! of the FLDDB which succeeded, or a negative error indication.
; 1302 !
; 1303 ! Formal parameters:
; 1304 ! Address of the first FLDDB, or zero for .CMINI
; 1305 ! Option flag: Low bit set to handle reparse, next bit set
; 1306 ! to allow indirect files; echo control for .CMINI
; 1307 ! For .CMINI, pointer to prompt string
; 1308 !
; 1309 ! Implicit inputs:
; 1310 ! None
; 1311 !
; 1312 ! Implicit outputs:
; 1313 ! System variables
; 1314 !
; 1315 ! Routine value:
; 1316 ! Address of successful FLDDB, or -1 if none succeeded,
; 1317 ! or -2 if a reparse happened
; 1318 !
; 1319 ! Side effects:
; 1320 ! None
; 1321 !
; 1322 !--
; 1323
; 1324 BEGIN
; 1325 EXTERNAL REGISTER Z=0;
; 1326 LOCAL
; 1327 SUCC, ! Address of successful FLDDB
; 1328 RETR2; ! R2 at exit from COMND%
; 1329 IF .FLDDB EQL 0 THEN RETURN PCMPRS(0,.PMTSTR,.OPTFLG);
; 1330 IF .POINTR((.FLDDB+$CMFNP),CM_FNC) EQL $CMFLS
; 1331 THEN
; 1332 SUCC = PRSFLS(.FLDDB,.OPTFLG)
; 1333 ELSE
; 1334 SUCC = PCMPRS(.FLDDB,RETR2,.OPTFLG);
; 1335 IF .SUCC GTR 0
; 1336 THEN
; 1337 CASE .POINTR((.SUCC+$CMFNP),CM_FNC) FROM $CMKEY TO $CMFLS OF
; 1338 SET
; 1339 [$CMKEY,
; 1340 $CMSWI]: UNPKEY(.RETR2);
; 1341 [$CMNUM]: BEGIN
; 1342 PCVVAL = .RETR2;
; 1343 UNPATM()
; 1344 END;
; 1345 [$CMIFI,
; 1346 $CMOFI,
; 1347 $CMFIL]: SUCC = UNPFIL(.RETR2,.SUCC);
; 1348 [$CMFLD,
; 1349 $CMDEV,
; 1350 $CMTXT,
; 1351 $CMQST,
; 1352 $CMNOD]: UNPATM();
; 1353 [$CMDIR,
; 1354 $CMUSR]: UNPUNM(.RETR2,.SUCC);
; 1355 [$CMTAD]: UNPTAD(.RETR2,.SUCC);
; 1356 [INRANGE]: ;
; 1357 TES;
; 1358 .SUCC
; 1359 END;
PCIPRS::PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,1 ; SP,1
MOVE AC4,AC3 ; PMTSTR,AC3
MOVE AC12,AC2 ; OPTFLG,AC2
MOVE AC14,AC1 ; FLDDB,AC1
JUMPN AC14,L.125 ; FLDDB,L.125
SETZ AC1, ; AC1,
MOVE AC2,AC4 ; AC2,PMTSTR
MOVE AC3,AC12 ; AC3,OPTFLG
PUSHJ SP,PCMPRS ; SP,PCMPRS
JRST L.136 ; L.136
L.125: LDB AC1,C.49 ; AC1,[POINT 9,0(FLDDB),8] <27,9>
CAIE AC1,27 ; AC1,27
JRST L.126 ; L.126
MOVE AC1,AC14 ; AC1,FLDDB
MOVE AC2,AC12 ; AC2,OPTFLG
PUSHJ SP,PRSFLS ; SP,PRSFLS
JRST L.127 ; L.127
L.126: MOVEI AC2,0(SP) ; AC2,RETR2
MOVE AC1,AC14 ; AC1,FLDDB
MOVE AC3,AC12 ; AC3,OPTFLG
PUSHJ SP,PCMPRS ; SP,PCMPRS
L.127: MOVE AC13,AC1 ; SUCC,AC1
JUMPLE AC13,L.135 ; SUCC,L.135
LDB AC1,C.50 ; AC1,[POINT 9,0(SUCC),8] <27,9>
JRST L.128(AC1) ; L.128(AC1)
L.128: JRST L.129 ; L.129
JRST L.130 ; L.130
JRST L.135 ; L.135
JRST L.129 ; L.129
JRST L.131 ; L.131
JRST L.131 ; L.131
JRST L.131 ; L.131
JRST L.132 ; L.132
JRST L.135 ; L.135
JRST L.133 ; L.133
JRST L.133 ; L.133
JRST L.135 ; L.135
JRST L.135 ; L.135
JRST L.135 ; L.135
JRST L.132 ; L.132
JRST L.132 ; L.132
JRST L.134 ; L.134
JRST L.132 ; L.132
JRST L.135 ; L.135
JRST L.135 ; L.135
JRST L.135 ; L.135
JRST L.135 ; L.135
JRST L.132 ; L.132
JRST L.135 ; L.135
L.129: MOVE AC1,0(SP) ; AC1,RETR2
PUSHJ SP,UNPKEY ; SP,UNPKEY
JRST L.135 ; L.135
L.130: MOVE AC1,0(SP) ; AC1,RETR2
MOVEM AC1,PCVVAL ; AC1,PCVVAL
JRST L.132 ; L.132
L.131: MOVE AC1,0(SP) ; AC1,RETR2
MOVE AC2,AC13 ; AC2,SUCC
PUSHJ SP,UNPFIL ; SP,UNPFIL
MOVE AC13,AC1 ; SUCC,AC1
JRST L.135 ; L.135
L.132: PUSHJ SP,UNPATM ; SP,UNPATM
JRST L.135 ; L.135
L.133: MOVE AC1,0(SP) ; AC1,RETR2
MOVE AC2,AC13 ; AC2,SUCC
PUSHJ SP,UNPUNM ; SP,UNPUNM
JRST L.135 ; L.135
L.134: MOVE AC1,0(SP) ; AC1,RETR2
MOVE AC2,AC13 ; AC2,SUCC
PUSHJ SP,UNPTAD ; SP,UNPTAD
L.135: MOVE AC1,AC13 ; AC1,SUCC
L.136: ADJSP SP,-1 ; SP,-1
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.49: POINT 9,0(AC14),8 ; 9,0(FLDDB),8
C.50: POINT 9,0(AC13),8 ; 9,0(SUCC),8
; Routine Size: 80 words
; 1360
; 1361 ROUTINE UNPFIL(RETR2,SUCC) = ! Save parsed JFN
; 1362
; 1363 !++
; 1364 ! Functional description:
; 1365 ! Save JFN returned by COMND% in list in ECB.
; 1366 !
; 1367 ! Formal parameters:
; 1368 ! JFN
; 1369 ! Address of successful FLDDB
; 1370 !
; 1371 ! Implicit inputs:
; 1372 ! ECB
; 1373 !
; 1374 ! Implicit outputs:
; 1375 ! None
; 1376 !
; 1377 ! Routine value:
; 1378 ! .SUCC if successful, -1 if error (wildcard given when not allowed)
; 1379 !
; 1380 ! Side effects:
; 1381 ! None
; 1382 !
; 1383 !--
; 1384
; 1385 BEGIN
; 1386 EXTERNAL REGISTER Z=0;
; 1387 LOCAL
; 1388 LST: REF JLS_WRD; ! JFN list pointer
; 1389 PCIRPL();
; 1390 IF .POINTR((.SUCC+$CMFNP),CM_WLD) EQL 0
; 1391 THEN
; 1392 IF (.RETR2 AND (GJ_DEV OR GJ_DIR OR GJ_NAM OR GJ_EXT OR GJ_VER)) NEQ 0
; 1393 THEN
; 1394 BEGIN
; 1395 REGISTER R1=1,R2=2;
; 1396 R1 = $FHSLF;
; 1397 R2 = DESX7;
; 1398 JSYS(0,SETER,R1,R2);
; 1399 RETURN -1; ! Error if wildcards given but not allowed
; 1400 END;
; 1401 LST = PCMGMM(2, XDICT);
; 1402 PCCURC[ECB_PFL] = .LST;
; 1403 LST[JLS_JFN] = .RETR2;
; 1404 LST[JLS_LNK] = 0;
; 1405 LST[JLS_WLD] = .POINTR((.SUCC+$CMFNP),CM_WLD);
; 1406 JUNSTK();
; 1407 .SUCC
; 1408 END;
UNPFIL: PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC2 ; SUCC,AC2
MOVE AC13,AC1 ; RETR2,AC1
PUSHJ SP,PCIRPL ; SP,PCIRPL
LDB AC1,C.51 ; AC1,[POINT 1,0(SUCC),11] <24,1>
JUMPN AC1,L.137 ; AC1,L.137
TLNN AC13,-210000 ; RETR2,-210000
JRST L.137 ; L.137
MOVEI AC1,400000 ; R1,400000
MOVEI AC2,-177622 ; R2,-177622
JSYS 336 ; 336
SETO AC1, ; AC1,
JRST L.138 ; L.138
L.137: MOVEI AC1,2 ; AC1,2
MOVEI AC2,XDICT ; AC2,XDICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
MOVE AC2,PCCURC ; AC2,PCCURC
HRRM AC1,10(AC2) ; LST,10(AC2)
MOVEM AC13,1(AC1) ; RETR2,1(LST)
HLLZS 0(AC1) ; 0(LST)
LDB AC2,C.51 ; AC2,[POINT 1,0(SUCC),11] <24,1>
DPB AC2,C.10 ; AC2,[POINT 1,0(AC1),0] <35,1>
PUSHJ SP,JUNSTK ; SP,JUNSTK
MOVE AC1,AC14 ; AC1,SUCC
L.138: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.51: POINT 1,0(AC14),11 ; 1,0(SUCC),11
; Routine Size: 29 words
; 1409
; 1410 ROUTINE UNPUNM(RETR2,SUCC): NOVALUE = ! Unparse directory/user name
; 1411
; 1412 !++
; 1413 ! Functional description:
; 1414 ! Given directory or user number returned by COMND%, store the
; 1415 ! corresponding directory or user name in the atom buffer and
; 1416 ! copy it into $ATOM.
; 1417 !
; 1418 ! Formal parameters:
; 1419 ! Directory/user number
; 1420 ! Address of successful FLDDB
; 1421 !
; 1422 ! Implicit inputs:
; 1423 ! None
; 1424 !
; 1425 ! Implicit outputs:
; 1426 ! $ATOM
; 1427 !
; 1428 ! Routine value:
; 1429 ! None
; 1430 !
; 1431 ! Side effects:
; 1432 ! None
; 1433 !
; 1434 !--
; 1435
; 1436 BEGIN
; 1437 EXTERNAL REGISTER Z=0;
; 1438 IF .POINTR((.SUCC+$CMFNP),CM_PO) EQL 0
; 1439 THEN
; 1440 BEGIN
; 1441 REGISTER R1=1,R2=2;
; 1442 R1 = CH$PTR(ATMBUF);
; 1443 R2 = .RETR2;
; 1444 IF NOT JSYS(1,DIRST,R1,R2) THEN ATMBUF = 0
; 1445 END;
; 1446 UNPATM()
; 1447 END;
UNPUNM: MOVE AC3,AC1 ; RETR2,AC1
LDB AC1,C.52 ; AC1,[POINT 1,0(SUCC),14] <21,1>
JUMPN AC1,UNPATM ; AC1,UNPATM
MOVE AC1,C.53 ; R1,[POINT 7,ATMBUF-1,34] <1,7>
MOVE AC2,AC3 ; R2,RETR2
JSYS 41 ; 41
JRST L.139 ; L.139
JRST UNPATM ; UNPATM
L.139: SETZM ATMBUF ; ATMBUF
JRST UNPATM ; UNPATM
C.52: POINT 1,0(AC2),14 ; 1,0(SUCC),14
C.53: POINT 7,ATMBUF-1,34 ; 7,ATMBUF-1,34
; Routine Size: 12 words
; 1448
; 1449 ROUTINE UNPTAD(RETR2,FDB): NOVALUE = ! Unparse parsed date-time
; 1450
; 1451 !++
; 1452 ! Functional description:
; 1453 ! Store parsed date and time in atom buffer, copy to $ATOM.
; 1454 ! Store internal date and time as integer in $VALUE.
; 1455 !
; 1456 ! Formal parameters:
; 1457 ! Internal date and time returned by COMND%
; 1458 ! Address of the .CMTAD FLDDB
; 1459 !
; 1460 ! Implicit inputs:
; 1461 ! None
; 1462 !
; 1463 ! Implicit outputs:
; 1464 ! $ATOM, $VALUE
; 1465 !
; 1466 ! Routine value:
; 1467 ! None
; 1468 !
; 1469 ! Side effects:
; 1470 ! None
; 1471 !
; 1472 !--
; 1473
; 1474 BEGIN
; 1475 EXTERNAL REGISTER Z=0;
; 1476 MAP
; 1477 FDB: REF VECTOR; ! FLDDB
; 1478 BEGIN
; 1479 REGISTER R1=1,R2=2,R3=3;
; 1480 R1 = CH$PTR(ATMBUF);
; 1481 R2 = .RETR2;
; 1482 R3 = 0;
; 1483 IF .POINTR((FDB[$CMDAT]),CM_IDA) EQL 0 THEN R3 = .R3 + OT_NDA;
; 1484 IF .POINTR((FDB[$CMDAT]),CM_ITM) EQL 0 THEN R3 = .R3 + OT_NTM;
; 1485 JSYS(0,ODTIM,R1,R2,R3)
; 1486 END;
; 1487 PCVVAL = .RETR2;
; 1488 UNPATM()
; 1489 END;
UNPTAD: MOVE AC4,AC2 ; FDB,AC2
MOVE AC5,AC1 ; RETR2,AC1
MOVE AC1,C.53 ; R1,[POINT 7,ATMBUF-1,34] <1,7>
MOVE AC2,AC5 ; R2,RETR2
SETZ AC3, ; R3,
LDB AC16,C.54 ; AC16,[POINT 1,1(FDB),0] <35,1>
JUMPN AC16,L.140 ; AC16,L.140
TLC AC3,400000 ; R3,400000
L.140: LDB AC16,C.55 ; AC16,[POINT 1,1(FDB),1] <34,1>
JUMPN AC16,L.141 ; AC16,L.141
ADD AC3,C.56 ; R3,[400000000]
L.141: JSYS 220 ; 220
MOVEM AC5,PCVVAL ; RETR2,PCVVAL
JRST UNPATM ; UNPATM
C.54: POINT 1,1(AC4),0 ; 1,1(FDB),0
C.55: POINT 1,1(AC4),1 ; 1,1(FDB),1
C.56: EXP 400000000 ; 400000000
; Routine Size: 17 words
; 1490
; 1491 ROUTINE UNPKEY(RETR2): NOVALUE = ! Unparse keyword/switch
; 1492
; 1493 !++
; 1494 ! Functional description:
; 1495 ! Fill in $ATOM and $VALUE with keyword/switch text and value.
; 1496 !
; 1497 ! Formal parameters:
; 1498 ! Address of successful entry in table
; 1499 !
; 1500 ! Implicit inputs:
; 1501 ! None
; 1502 !
; 1503 ! Implicit outputs:
; 1504 ! $ATOM, $VALUE
; 1505 !
; 1506 ! Routine value:
; 1507 ! None
; 1508 !
; 1509 ! Side effects:
; 1510 ! None
; 1511 !
; 1512 !--
; 1513
; 1514 BEGIN
; 1515 EXTERNAL REGISTER Z=0;
; 1516 LOCAL
; 1517 HW: HLF_WRD,
; 1518 PTRI,
; 1519 PTRO,
; 1520 CHR;
; 1521 HW = ..RETR2;
; 1522 PCVVAL = .HW<0,18,1>; ! Get and sign-extend the value
; 1523 PTRI = BYTPTR(.HW[HLF_LFT]);
; 1524 PTRO = BYTPTR(ATMBUF);
; 1525 DO (CHR = CH$RCHAR_A(PTRI); CH$WCHAR_A(.CHR,PTRO)) UNTIL .CHR EQL $CHNUL;
; 1526 UNPATM()
; 1527 END;
UNPKEY: MOVE AC1,0(AC1) ; HW,0(RETR2)
HRREM AC1,PCVVAL ; HW,PCVVAL
HLRZ AC1,AC1 ; HLF,HW
HRLI AC1,-337100 ; HLF,-337100
MOVE AC3,AC1 ; PTRI,HLF
MOVEI AC1,ATMBUF ; HLF,ATMBUF
HRLI AC1,-337100 ; HLF,-337100
MOVE AC2,AC1 ; PTRO,HLF
L.142: ILDB AC1,AC3 ; CHR,PTRI
IDPB AC1,AC2 ; CHR,PTRO
JUMPN AC1,L.142 ; CHR,L.142
JRST UNPATM ; UNPATM
; Routine Size: 12 words
; 1528
; 1529 ROUTINE UNPATM: NOVALUE = ! Copy atom buffer
; 1530
; 1531 !++
; 1532 ! Functional description:
; 1533 ! Copy current contents of atom buffer into permanent storage
; 1534 ! block; replace $ATOM with it.
; 1535 !
; 1536 ! Formal parameters:
; 1537 ! None
; 1538 !
; 1539 ! Implicit inputs:
; 1540 ! ATMBUF
; 1541 !
; 1542 ! Implicit outputs:
; 1543 ! PCVATM
; 1544 !
; 1545 ! Routine value:
; 1546 ! None
; 1547 !
; 1548 ! Side effects:
; 1549 ! None
; 1550 !
; 1551 !--
; 1552
; 1553 BEGIN
; 1554 EXTERNAL REGISTER Z=0;
; 1555 LOCAL
; 1556 CNT, ! Character count
; 1557 PTR; ! String pointer
; 1558 IF .PCVATM NEQ 0
; 1559 THEN
; 1560 RETMEM((.PCVATM[STV_LEN]+5)/5, .PCVATM[STV_ADR], XDICT);
; 1561 CNT = 0;
; 1562 PTR = BYTPTR(ATMBUF);
; 1563 WHILE CH$RCHAR_A(PTR) NEQ $CHNUL DO CNT = .CNT + 1;
; 1564 PCVATM[STV_LEN] = .CNT;
; 1565 PTR = GTBUFX((.CNT+5)/5);
; 1566 PCVATM[STV_ADR] = .PTR;
; 1567 CH$MOVE(.CNT+1, CH$PTR(ATMBUF), BYTPTR(.PTR))
; 1568 END;
UNPATM: PUSH SP,AC14 ; SP,AC14
SKIPN PCVATM ; PCVATM
JRST L.143 ; L.143
HLRZ AC1,PCVATM ; AC1,PCVATM
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
HRRZ AC2,PCVATM ; AC2,PCVATM
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
L.143: SETZ AC14, ; CNT,
MOVEI AC1,ATMBUF ; HLF,ATMBUF
HRLI AC1,-337100 ; HLF,-337100
MOVE AC3,AC1 ; PTR,HLF
L.144: ILDB AC1,AC3 ; AC1,PTR
JUMPE AC1,L.145 ; AC1,L.145
AOJA AC14,L.144 ; CNT,L.144
L.145: HRLM AC14,PCVATM ; CNT,PCVATM
MOVE AC1,AC14 ; AC1,CNT
ADDI AC1,5 ; AC1,5
IDIVI AC1,5 ; AC1,5
PUSHJ SP,GTBUFX ; SP,GTBUFX
MOVE AC3,AC1 ; PTR,AC1
HRRM AC3,PCVATM ; PTR,PCVATM
MOVE AC1,AC14 ; AC1,CNT
ADDI AC1,1 ; AC1,1
MOVE AC5,AC3 ; HLF,PTR
HRLI AC5,-337100 ; HLF,-337100
MOVE AC2,C.53 ; AC2,[POINT 7,ATMBUF-1,34] <1,7>
MOVE AC4,AC1 ; AC4,AC1
EXTEND AC1,C.8 ; AC1,[MOVSLJ ]
JFCL ;
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 33 words
; 1569
; 1570 ROUTINE PRSFLS(FDB,OPTFLG) = ! Do Parse File List
; 1571
; 1572 !++
; 1573 ! Functional description:
; 1574 ! Do processing for parsing a file list. This routine gets the names
; 1575 ! parsed and stores the JFN list.
; 1576 !
; 1577 ! Formal parameters:
; 1578 ! Address of the FLDDB
; 1579 ! Option flag to pass to PCMPRS
; 1580 !
; 1581 ! Implicit inputs:
; 1582 ! None
; 1583 !
; 1584 ! Implicit outputs:
; 1585 ! Parsed JFN list
; 1586 !
; 1587 ! Routine value:
; 1588 ! Address of FLDDB, or -1 if a file parse failed, or -2 for reparse
; 1589 !
; 1590 ! Side effects:
; 1591 ! None
; 1592 !
; 1593 !--
; 1594
; 1595 BEGIN
; 1596 EXTERNAL REGISTER Z=0;
; 1597 LOCAL
; 1598 RETR2; ! R2 returned from COMND
; 1599 MAP
; 1600 FDB: REF VECTOR; ! FLDDB
; 1601 BIND
; 1602 CMA_FLDDB = UPLIT($CMCMA^27,0,0,0);
; 1603
; 1604 PCIRPL();
; 1605 POINTR((FDB[$CMFNP]),CM_FNC) = $CMFIL;
; 1606 DO
; 1607 BEGIN
; 1608 LOCAL
; 1609 LST: REF JLS_WRD, ! List pointers
; 1610 ENT: REF JLS_WRD,
; 1611 VAL;
; 1612 VAL = PCMPRS(.FDB,RETR2,.OPTFLG);
; 1613 IF .VAL LSS 0 THEN RETURN .VAL;
; 1614 !!! The following makes FILELIST fail if WILD was not specified in the
; 1615 !!! parse. To make this work, put this code back in and don't set GJ%IFG
; 1616 !!! automatically if user does a PARSE FILELIST. This code is out at the
; 1617 !!! moment 'cause it might break many things and I'm not sure it is a good
; 1618 !!! idea anyway:
; 1619 !!! IF .POINTR((FDB[$CMFNP]),CM_WLD) EQL 0
; 1620 !!! THEN
; 1621 !!! IF (.RETR2 AND (GJ_DEV OR GJ_DIR OR GJ_NAM OR GJ_EXT OR GJ_VER))
; 1622 !!! NEQ 0
; 1623 !!! THEN
; 1624 !!! BEGIN
; 1625 !!! REGISTER R1=1,R2=2;
; 1626 !!! R1 = $FHSLF;
; 1627 !!! R2 = DESX7;
; 1628 !!! JSYS(0,SETER,R1,R2);
; 1629 !!! RETURN -1; ! Error if wildcards given but not allowed
; 1630 !!! END;
; 1631 ENT = PCMGMM(2, XDICT);
; 1632 ENT[JLS_JFN] = .RETR2;
; 1633 ENT[JLS_LNK] = 0;
; 1634 ENT[JLS_WLD] = .POINTR((FDB[$CMFNP]),CM_WLD);
; 1635 JUNSTK();
; 1636 LST = .PCCURC[ECB_PFL];
; 1637 IF .LST EQL 0
; 1638 THEN
; 1639 PCCURC[ECB_PFL] = .ENT
; 1640 ELSE
; 1641 BEGIN
; 1642 WHILE .LST[JLS_LNK] NEQ 0 DO LST=.LST[JLS_LNK];
; 1643 LST[JLS_LNK] = .ENT
; 1644 END
; 1645 END
; 1646 UNTIL
; 1647 BEGIN
; 1648 LOCAL VAL;
; 1649 VAL = PCMPRS(CMA_FLDDB,RETR2,.OPTFLG);
; 1650 IF .VAL EQL -2 THEN RETURN -2;
; 1651 .VAL LSS 0
; 1652 END;
; 1653 POINTR((FDB[$CMFNP]),CM_FNC) = $CMFLS;
; 1654 .FDB
; 1655 END;
P.AAM: EXP 13000000000
EXP 0
EXP 0
EXP 0
CMA_FLDDB= P.AAM
PRSFLS: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,1 ; SP,1
MOVE AC12,AC2 ; OPTFLG,AC2
MOVE AC13,AC1 ; FDB,AC1
PUSHJ SP,PCIRPL ; SP,PCIRPL
MOVEI AC1,6 ; AC1,6
DPB AC1,C.50 ; AC1,[POINT 9,0(AC13),8] <27,9>
L.146: MOVEI AC2,0(SP) ; AC2,RETR2
MOVE AC1,AC13 ; AC1,FDB
MOVE AC3,AC12 ; AC3,OPTFLG
PUSHJ SP,PCMPRS ; SP,PCMPRS
JUMPL AC1,L.151 ; VAL,L.151
MOVEI AC1,2 ; AC1,2
MOVEI AC2,XDICT ; AC2,XDICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
MOVE AC14,AC1 ; ENT,AC1
MOVE AC1,0(SP) ; AC1,RETR2
MOVEM AC1,1(AC14) ; AC1,1(ENT)
HLLZS 0(AC14) ; 0(ENT)
LDB AC1,C.57 ; AC1,[POINT 1,0(FDB),11] <24,1>
DPB AC1,C.58 ; AC1,[POINT 1,0(ENT),0] <35,1>
PUSHJ SP,JUNSTK ; SP,JUNSTK
MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC2,10(AC1) ; LST,10(AC1)
JUMPN AC2,L.147 ; LST,L.147
HRRM AC14,10(AC1) ; ENT,10(AC1)
JRST L.149 ; L.149
L.147: HRRZ AC1,0(AC2) ; AC1,0(LST)
JUMPE AC1,L.148 ; AC1,L.148
MOVE AC2,AC1 ; LST,AC1
JRST L.147 ; L.147
L.148: HRRM AC14,0(AC2) ; ENT,0(LST)
L.149: MOVEI AC2,0(SP) ; AC2,RETR2
MOVEI AC1,CMA_FLDDB ; AC1,CMA_FLDDB
MOVE AC3,AC12 ; AC3,OPTFLG
PUSHJ SP,PCMPRS ; SP,PCMPRS
CAME AC1,C.59 ; VAL,[-2]
JRST L.150 ; L.150
HRROI AC1,-2 ; AC1,-2
JRST L.151 ; L.151
L.150: JUMPGE AC1,L.146 ; VAL,L.146
MOVEI AC1,27 ; AC1,27
DPB AC1,C.50 ; AC1,[POINT 9,0(AC13),8] <27,9>
MOVE AC1,AC13 ; AC1,FDB
L.151: ADJSP SP,-1 ; SP,-1
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
C.57: POINT 1,0(AC13),11 ; 1,0(FDB),11
C.58: POINT 1,0(AC14),0 ; 1,0(ENT),0
C.59: EXP -2 ; -2
; Routine Size: 54 words
; 1656
; 1657 GLOBAL ROUTINE PCIIVK(PTR,PASS): NOVALUE = ! Invoke user program
; 1658
; 1659 !++
; 1660 ! Functional description:
; 1661 ! Get and start up user program under control of PCL. This is called
; 1662 ! by executing an Invoke statement, with the user providing a string
; 1663 ! which contains the name of an executable file. I run the program
; 1664 ! in much the same fashion as if the user had issued a Run command,
; 1665 ! the only (desired) exception being that the program's controlling
; 1666 ! terminal (and primary I/O designators) are redirected to a PTY for
; 1667 ! PCL control. After starting the program, I wait for the program to
; 1668 ! either halt or require terminal input, at which time PCL execution
; 1669 ! proceeds. While running, the terminal may well write to its primary
; 1670 ! output; this will be read from the PTY and saved in the program output
; 1671 ! buffer for the user to see, unless PassOutput is specified, in which
; 1672 ! case it is typed immediately.
; 1673 !
; 1674 ! Formal parameters:
; 1675 ! Stringvalue of string containing name of file to execute
; 1676 ! Nonzero to pass output without buffering
; 1677 !
; 1678 ! Implicit inputs:
; 1679 ! None
; 1680 !
; 1681 ! Implicit outputs:
; 1682 ! None
; 1683 !
; 1684 ! Routine value:
; 1685 ! None
; 1686 !
; 1687 ! Side effects:
; 1688 ! None
; 1689 !
; 1690 !--
; 1691
; 1692 BEGIN
; 1693 EXTERNAL REGISTER Z=0;
; 1694 LOCAL
; 1695 JFN, ! JFN on PDS
; 1696 NUM; ! Number of PDS
; 1697 PCFORK = .FORK; ! Save old value of FORK
; 1698 PCRNFK = .RUNFK; ! and RUNFK
; 1699 INIIVK(.PTR);
; 1700 IF .PCCURC[ECB_CTN] EQL 0
; 1701 THEN
; 1702 BEGIN
; 1703 FNDCTY(JFN,NUM);
; 1704 PCCURC[ECB_CTN] = .NUM;
; 1705 PCCURC[ECB_CTJ] = .JFN
; 1706 END;
; 1707 PCCURC[ECB_PAS] = .PASS;
; 1708 REDFRK(1);
; 1709 WTFPGM();
; 1710 FORK = .PCFORK;
; 1711 RUNFK = .PCRNFK;
; 1712 PCFORK = -2;
; 1713 PCRNFK = -2;
; 1714 END;
PCIIVK::PUSH SP,AC14 ; SP,AC14
ADJSP SP,2 ; SP,2
MOVE AC14,AC2 ; PASS,AC2
MOVE AC2,FORK ; AC2,FORK
MOVEM AC2,PCFORK ; AC2,PCFORK
MOVE AC2,RUNFK ; AC2,RUNFK
MOVEM AC2,PCRNFK ; AC2,PCRNFK
PUSHJ SP,INIIVK ; SP,INIIVK
MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC2,4(AC1) ; AC2,4(AC1)
JUMPN AC2,L.152 ; AC2,L.152
MOVEI AC1,-1(SP) ; AC1,JFN
MOVEI AC2,0(SP) ; AC2,NUM
PUSHJ SP,FNDCTY ; SP,FNDCTY
MOVE AC1,PCCURC ; AC1,PCCURC
MOVE AC2,0(SP) ; AC2,NUM
HRRM AC2,4(AC1) ; AC2,4(AC1)
MOVE AC2,-1(SP) ; AC2,JFN
HRLM AC2,4(AC1) ; AC2,4(AC1)
L.152: MOVE AC1,PCCURC ; AC1,PCCURC
DPB AC14,C.60 ; PASS,[POINT 1,12(AC1),4] <31,1>
MOVEI AC1,1 ; AC1,1
PUSHJ SP,REDFRK ; SP,REDFRK
PUSHJ SP,WTFPGM ; SP,WTFPGM
MOVE AC1,PCFORK ; AC1,PCFORK
MOVEM AC1,FORK ; AC1,FORK
MOVE AC1,PCRNFK ; AC1,PCRNFK
MOVEM AC1,RUNFK ; AC1,RUNFK
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,PCFORK ; AC1,PCFORK
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,PCRNFK ; AC1,PCRNFK
ADJSP SP,-2 ; SP,-2
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
C.60: POINT 1,12(AC1),4 ; 1,12(AC1),4
; Routine Size: 36 words
; 1715
; 1716 ROUTINE INIIVK(NAMVAL): NOVALUE = ! Initialize fork for Invoke
; 1717
; 1718 !++
; 1719 ! Functional description:
; 1720 ! Does fork initialization for Invoke statement: Gets and stacks
; 1721 ! program JFN, clears out program environment (like a Reset command),
; 1722 ! makes a fork, and gets the program into the fork. Zeroes STAYF so
; 1723 ! that the fork does not run in the background.
; 1724 !
; 1725 ! Formal parameters:
; 1726 ! Stringvalue of string containing program name
; 1727 !
; 1728 ! Implicit inputs:
; 1729 ! None
; 1730 !
; 1731 ! Implicit outputs:
; 1732 ! FORK
; 1733 !
; 1734 ! Routine value:
; 1735 ! None
; 1736 !
; 1737 ! Side effects:
; 1738 ! None
; 1739 !
; 1740 !--
; 1741
; 1742 BEGIN
; 1743 EXTERNAL REGISTER Z=0;
; 1744 LOCAL
; 1745 JFN, ! JFN
; 1746 CNT, ! Counter
; 1747 HLFTMP: HLF_WRD, ! Temporary
; 1748 GJBLK: VECTOR[$GJF2]; ! Long GTJFN% block
; 1749 MAP
; 1750 NAMVAL: STR_VAL; ! Argument
; 1751 DECR I FROM $GJJFN DO GJBLK[.I] = 0;
; 1752 GJBLK[$GJGEN] = GJ_OLD;
; 1753 GJBLK[$GJSRC] = $NULIO ^ 18 + $NULIO;
; 1754 GJBLK[$GJEXT] = CH$PTR(UPLIT(%ASCIZ 'EXE'));
; 1755 JFN = PCMGJS(GJBLK[0], BYTPTR(.NAMVAL[STV_ADR]));
; 1756 IF .JFN LSS 0 THEN ERROR('Unable to get file');
; 1757 PCIKIF();
; 1758 ECFORK();
; 1759 PCCURC[ECB_CFK] = .FORK;
; 1760 PCCURC[ECB_FNI] = 0;
; 1761 PCMSPN(.JFN);
; 1762 HLFTMP[HLF_LFT] = .FORK;
; 1763 HLFTMP[HLF_RGT] = .JFN;
; 1764 BEGIN
; 1765 REGISTER R1=1;
; 1766 R1=.HLFTMP;
; 1767 IF NOT MACHSKIP(%O'260',15,DOGET,0,0)
; 1768 THEN
; 1769 ERROR('Unable to get program')
; 1770 END;
; 1771 BEGIN
; 1772 REGISTER R1=1;
; 1773 R1 = CH$PTR(UPLIT(0));
; 1774 JSYS(1,RSCAN,R1)
; 1775 END;
; 1776 SETINV(.FORK);
; 1777 STAYF = 0;
; 1778 END;
P.AAN: BYTE (7)"E","X","E",000,000 ; EXE
P.AAO: BYTE (7)"U","n","a","b","l" ; Unabl
BYTE (7)"e"," ","t","o"," " ; e to
BYTE (7)"g","e","t"," ","f" ; get f
BYTE (7)"i","l","e",000,000 ; ile
P.AAP: BYTE (7)"U","n","a","b","l" ; Unabl
BYTE (7)"e"," ","t","o"," " ; e to
BYTE (7)"g","e","t"," ","p" ; get p
BYTE (7)"r","o","g","r","a" ; rogra
BYTE (7)"m",000,000,000,000 ; m
P.AAQ: EXP 0
INIIVK: PUSH SP,AC14 ; SP,AC14
ADJSP SP,11 ; SP,11
MOVEI AC2,10 ; I,10
L.153: MOVEI AC3,-10(SP) ; AC3,GJBLK
ADD AC3,AC2 ; AC3,I
SETZM 0(AC3) ; 0(AC3)
SOJGE AC2,L.153 ; I,L.153
MOVSI AC2,100000 ; AC2,100000
MOVEM AC2,-10(SP) ; AC2,GJBLK
MOVE AC2,C.61 ; AC2,[377777377777]
MOVEM AC2,-7(SP) ; AC2,GJBLK+1
MOVE AC2,C.62 ; AC2,[POINT 7,P.AAN-1,34] <1,7>
MOVEM AC2,-3(SP) ; AC2,GJBLK+5
MOVEI AC3,-10(SP) ; AC3,GJBLK
MOVEI AC2,0(AC1) ; HLF,0(NAMVAL)
HRLI AC2,-337100 ; HLF,-337100
MOVE AC1,AC3 ; AC1,AC3
PUSHJ SP,PCMGJS ; SP,PCMGJS
MOVE AC14,AC1 ; JFN,AC1
JUMPGE AC14,L.154 ; JFN,L.154
MOVEI AC1,P.AAO ; AC1,P.AAO
PUSHJ SP,PCMXER ; SP,PCMXER
L.154: PUSHJ SP,PCIKIF ; SP,PCIKIF
PUSHJ SP,ECFORK ; SP,ECFORK
MOVE AC1,PCCURC ; AC1,PCCURC
MOVE AC2,FORK ; AC2,FORK
HRLM AC2,10(AC1) ; AC2,10(AC1)
MOVSI AC2,200000 ; AC2,200000
ANDCAM AC2,12(AC1) ; AC2,12(AC1)
MOVE AC1,AC14 ; AC1,JFN
PUSHJ SP,PCMSPN ; SP,PCMSPN
HRL AC1,FORK ; HLFTMP,FORK
HRR AC1,AC14 ; HLFTMP,JFN
PUSHJ 17,DOGET ; 17,DOGET
JRST L.155 ; L.155
JRST L.156 ; L.156
L.155: MOVEI AC1,P.AAP ; AC1,P.AAP
PUSHJ SP,PCMXER ; SP,PCMXER
L.156: MOVE AC1,C.63 ; R1,[POINT 7,P.AAQ-1,34] <1,7>
JSYS 500 ; 500
JFCL ;
MOVE AC1,FORK ; AC1,FORK
PUSHJ SP,SETINV ; SP,SETINV
SETZM STAYF ; STAYF
ADJSP SP,-11 ; SP,-11
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
C.61: EXP 377777377777 ; 377777377777
C.62: POINT 7,P.AAN-1,34 ; 7,P.AAN-1,34
C.63: POINT 7,P.AAQ-1,34 ; 7,P.AAQ-1,34
; Routine Size: 50 words
; 1779
; 1780 ROUTINE FNDCTY(AJFN,ANUM): NOVALUE = ! Get a PDS for PCL
; 1781
; 1782 !++
; 1783 ! Functional description:
; 1784 ! Get a PTY or a PDS for use as a fork controller or a DoCommand
; 1785 ! output handler; open it and set up the Exec to handle the
; 1786 ! interrupts. Return the JFN and PTY/PDS number in the caller's
; 1787 ! arguments.
; 1788 !
; 1789 ! Formal parameters:
; 1790 ! Addresses of words in which to store JFN and device number
; 1791 !
; 1792 ! Implicit inputs:
; 1793 ! None
; 1794 !
; 1795 ! Implicit outputs:
; 1796 ! None
; 1797 !
; 1798 ! Routine value:
; 1799 ! None
; 1800 !
; 1801 ! Side effects:
; 1802 ! None
; 1803 !
; 1804 !--
; 1805
; L 1806 %IF %VARIANT
; U 1807 %THEN
; U 1808 BEGIN
; U 1809 EXTERNAL REGISTER Z=0;
; U 1810 LOCAL
; U 1811 JFN, ! JFN
; U 1812 NUM; ! Device number
; U 1813 BEGIN
; U 1814 REGISTER R1=1,R2=2;
; U 1815 R1 = GJ_SHT;
; U 1816 R2 = BYTPTR(UPLIT (%ASCIZ 'PDS:'));
; U 1817 IF NOT JSYS(1,GTJFN,R1,R2) THEN R1=-1;
; U 1818 JFN = .R1
; U 1819 END;
; U 1820 IF .JFN GTR 0
; U 1821 THEN
; U 1822 BEGIN
; U 1823 IF
; U 1824 BEGIN
; U 1825 REGISTER R1=1,R2=2;
; U 1826 R1 = .JFN;
; U 1827 R2 = FLD(8,OF_BSZ) + OF_RD + OF_WR;
; U 1828 JSYS(1,OPENF,R1,R2)
; U 1829 END
; U 1830 THEN
; U 1831 BEGIN
; U 1832 BEGIN
; U 1833 REGISTER R1=1,R2;
; U 1834 R1 = .JFN;
; U 1835 R2 = $MOITY;
; U 1836 IF JSYS(-1,MTOPR,R1,R2) THEN NUM = .R2;
; U 1837 END;
; U 1838 IF .NUM NEQ 0
; U 1839 THEN
; U 1840 BEGIN
; U 1841 REGISTER R1=1,R2=2;
; U 1842 R1 = .JFN;
; U 1843 R2 = $MOAPI + MO_WFI + MO_OIR + FLD(PCLCHI,MO_SIC);
; U 1844 JSYS(-1,MTOPR,R1,R2);
; U 1845 .AJFN = .JFN;
; U 1846 .ANUM = .NUM
; U 1847 END;
; U 1848 RETURN
; U 1849 END
; U 1850 ELSE
; U 1851 BEGIN
; U 1852 REGISTER R1=1;
; U 1853 R1 = .JFN;
; U 1854 JSYS(1,RLJFN,R1)
; U 1855 END
; U 1856 END;
; U 1857 ERROR('Unable to obtain PDS')
; U 1858 END;
; 1859 %ELSE
; 1860 BEGIN
; 1861 EXTERNAL REGISTER Z=0;
; 1862 LOCAL
; 1863 JFN, ! JFN
; 1864 NUM, ! PTY number
; 1865 R1T, ! Register temporaries
; 1866 R2T,
; 1867 FIRPTY, ! First PTY in system
; 1868 SYSPTY, ! Number of PTY's in system
; 1869 HLFTMP: HLF_WRD, ! Temporary
; 1870 PTYNAM: VECTOR[10]; ! PTY name
; 1871 BEGIN
; 1872 REGISTER R1=1;
; 1873 R1 = $PTYPA;
; 1874 JSYS(1,GETAB,R1);
; 1875 HLFTMP = .R1;
; 1876 FIRPTY = .HLFTMP[HLF_RGT];
; 1877 SYSPTY = .HLFTMP[HLF_LFT]
; 1878 END;
; 1879 INCR I TO .SYSPTY-1 DO
; 1880 BEGIN
; 1881 HLFTMP[HLF_LFT] = $DVDES + $DVPTY;
; 1882 HLFTMP[HLF_RGT] = .I;
; 1883 R1T = .HLFTMP;
; 1884 BEGIN
; 1885 REGISTER R1=1,R2=2;
; 1886 R1 = .R1T;
; 1887 JSYS(0,DVCHR,R1,R2);
; 1888 R1T = .R1;
; 1889 R2T = .R2
; 1890 END;
; 1891 IF .POINTR(R2T,DV_AV)
; 1892 THEN
; 1893 BEGIN
; 1894 R2T = .R1T;
; 1895 R1T = BYTPTR(PTYNAM);
; 1896 IF
; 1897 BEGIN
; 1898 LOCAL VAL;
; 1899 REGISTER R1=1,R2=2;
; 1900 R1=.R1T;
; 1901 R2=.R2T;
; 1902 VAL = JSYS(1,DEVST,R1,R2);
; 1903 R1T = .R1;
; 1904 .VAL
; 1905 END
; 1906 THEN
; 1907 BEGIN
; 1908 CH$WCHAR_A(%C':',R1T);
; 1909 CH$WCHAR_A(0,R1T);
; 1910 BEGIN
; 1911 REGISTER R1=1,R2=2;
; 1912 R1 = GJ_SHT;
; 1913 R2 = BYTPTR(PTYNAM);
; 1914 IF NOT JSYS(1,GTJFN,R1,R2) THEN R1=-1;
; 1915 JFN = .R1
; 1916 END;
; 1917 IF .JFN GTR 0
; 1918 THEN
; 1919 BEGIN
; 1920 R1T = .JFN;
; 1921 R2T = FLD(8,OF_BSZ) + OF_RD + OF_WR;
; 1922 IF
; 1923 BEGIN
; 1924 REGISTER R1=1,R2=2;
; 1925 R1=.R1T;
; 1926 R2=.R2T;
; 1927 JSYS(1,OPENF,R1,R2)
; 1928 END
; 1929 THEN
; 1930 BEGIN
; 1931 NUM = .I + .FIRPTY;
; 1932 BEGIN
; 1933 REGISTER R1=1;
; 1934 R1 = $TTDES + .NUM;
; 1935 JSYS(1,ASND,R1)
; 1936 END;
; 1937 .AJFN = .JFN;
; 1938 .ANUM = .NUM;
; 1939 BEGIN
; 1940 REGISTER R1=1,R2=2;
; 1941 R1 = .JFN;
; 1942 R2 = $MOAPI + MO_WFI + MO_OIR + FLD(PCLCHI,MO_SIC);
; 1943 JSYS(-1,MTOPR,R1,R2)
; 1944 END;
; 1945 RETURN
; 1946 END
; 1947 ELSE
; 1948 BEGIN
; 1949 REGISTER R1=1;
; 1950 R1 = .JFN;
; 1951 JSYS(1,RLJFN,R1)
; 1952 END
; 1953 END
; 1954 END
; 1955 END
; 1956 END;
; 1957 ERROR('Unable to obtain PTY')
; 1958 END;
P.AAR: BYTE (7)"U","n","a","b","l" ; Unabl
BYTE (7)"e"," ","t","o"," " ; e to
BYTE (7)"o","b","t","a","i" ; obtai
BYTE (7)"n"," ","P","T","Y" ; n PTY
BYTE (7)000,000,000,000,000
FNDCTY: 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,14 ; SP,14
MOVEM AC2,0(SP) ; AC2,0(SP)
MOVEM AC1,-1(SP) ; AC1,-1(SP)
MOVEI AC1,26 ; R1,26
JSYS 10 ; 10
JFCL ;
MOVE AC16,AC1 ; HLFTMP,R1
MOVEI AC11,0(AC16) ; FIRPTY,0(HLFTMP)
HLRZ AC1,AC16 ; SYSPTY,HLFTMP
MOVE AC10,AC1 ; AC10,SYSPTY
SETO AC13, ; I,
JRST L.161 ; L.161
L.157: HRLI AC16,-177765 ; HLFTMP,-177765
HRR AC16,AC13 ; HLFTMP,I
MOVE AC3,AC16 ; R1T,HLFTMP
MOVE AC1,AC3 ; R1,R1T
JSYS 117 ; 117
MOVE AC3,AC1 ; R1T,R1
MOVE AC14,AC2 ; R2T,R2
TLNN AC14,10000 ; R2T,10000
JRST L.161 ; L.161
MOVE AC14,AC3 ; R2T,R1T
MOVEI AC1,-13(SP) ; HLF,PTYNAM
HRLI AC1,-337100 ; HLF,-337100
MOVE AC3,AC1 ; R1T,HLF
MOVE AC2,AC14 ; R2,R2T
JSYS 121 ; 121
TDZA AC4,AC4 ; AC4,AC4
MOVEI AC4,1 ; AC4,1
MOVE AC2,AC4 ; VAL,AC4
MOVE AC3,AC1 ; R1T,R1
TRNN AC2,1 ; VAL,1
JRST L.161 ; L.161
MOVEI AC1,72 ; AC1,72
IDPB AC1,AC3 ; AC1,R1T
SETZ AC1, ; AC1,
IDPB AC1,AC3 ; AC1,R1T
MOVSI AC1,1 ; R1,1
MOVEI AC2,-13(SP) ; HLF,PTYNAM
HRLI AC2,-337100 ; HLF,-337100
JSYS 20 ; 20
JRST L.158 ; L.158
JRST L.159 ; L.159
L.158: SETO AC1, ; R1,
L.159: MOVE AC5,AC1 ; JFN,R1
JUMPLE AC5,L.161 ; JFN,L.161
MOVE AC3,AC5 ; R1T,JFN
MOVE AC14,C.64 ; R2T,[100000300000]
MOVE AC1,AC3 ; R1,R1T
MOVE AC2,AC14 ; R2,R2T
JSYS 21 ; 21
JRST L.160 ; L.160
MOVE AC12,AC13 ; NUM,I
ADD AC12,AC11 ; NUM,FIRPTY
MOVE AC1,AC12 ; R1,NUM
ADDI AC1,400000 ; R1,400000
JSYS 70 ; 70
JFCL ;
MOVE AC1,-1(SP) ; AC1,-1(SP)
MOVEM AC5,0(AC1) ; JFN,0(AC1)
MOVE AC1,0(SP) ; AC1,0(SP)
MOVEM AC12,0(AC1) ; NUM,0(AC1)
MOVE AC1,AC5 ; R1,JFN
MOVE AC2,C.65 ; R2,[<<PCLCHI_22>+<-177777777754>>]
JSYS 77 ; 77
JUMP 16,L.162 ; 16,L.162
JRST L.162 ; L.162
L.160: MOVE AC1,AC5 ; R1,JFN
JSYS 23 ; 23
JFCL ;
L.161: ADDI AC13,1 ; I,1
CAMGE AC13,AC10 ; I,AC10
JRST L.157 ; L.157
MOVEI AC1,P.AAR ; AC1,P.AAR
PUSHJ SP,PCMXER ; SP,PCMXER
L.162: ADJSP SP,-14 ; SP,-14
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.64: EXP 100000300000 ; 100000300000
C.65: EXP <<PCLCHI_22>+<-177777777754>> ; <<PCLCHI_22>+<-177777777754>>
; Routine Size: 89 words
; 1959 %FI
; 1960
; 1961 ROUTINE REDFRK(STRT): NOVALUE = ! Ready fork
; 1962
; 1963 !++
; 1964 ! Functional description:
; 1965 ! Set user program's controlling terminal and primary JFNs
; 1966 ! to PCL's PTY. As requested, either start fork running
; 1967 ! or continue it.
; 1968 !
; 1969 ! Formal parameters:
; 1970 ! Nonzero to start fork running, zero to continue
; 1971 !
; 1972 ! Implicit inputs:
; 1973 ! None
; 1974 !
; 1975 ! Implicit outputs:
; 1976 ! None
; 1977 !
; 1978 ! Routine value:
; 1979 ! None
; 1980 !
; 1981 ! Side effects:
; 1982 ! None
; 1983 !
; 1984 !--
; 1985
; 1986 BEGIN
; 1987 EXTERNAL REGISTER Z=0;
; 1988 LOCAL
; 1989 R1T, ! Register temporary
; 1990 R2T,
; 1991 DESIG, ! Designator
; 1992 HLFTMP: HLF_WRD; ! Temporary
; 1993 HLFTMP[HLF_LFT] = $SCSET;
; 1994 HLFTMP[HLF_RGT] = .PCCURC[ECB_CFK];
; 1995 DESIG = $TTDES + .PCCURC[ECB_CTN];
; 1996 BEGIN
; 1997 REGISTER R1=1,R2=2;
; 1998 R1 = .HLFTMP;
; 1999 R2 = .DESIG;
; 2000 JSYS(-1,SCTTY,R1,R2)
; 2001 END;
; 2002 HLFTMP[HLF_LFT] = .DESIG;
; 2003 HLFTMP[HLF_RGT] = .DESIG;
; 2004 R2T = .HLFTMP;
; 2005 R1T = .PCCURC[ECB_CFK];
; 2006 IF NOT
; 2007 BEGIN
; 2008 REGISTER R1=1,R2=2;
; 2009 R1=.R1T;
; 2010 R2=.R2T;
; 2011 JSYS(-1,SPJFN,R1,R2)
; 2012 END
; 2013 THEN
; 2014 ERROR('Unable to SPJFN');
; 2015 BEGIN
; 2016 REGISTER
; 2017 R1=1,R2=2;
; 2018 R1 = $TTDES + .PCCURC[ECB_CTN];
; 2019 JSYS(0,RFMOD,R1,R2);
; 2020 POINTR(R2,TT_LIC) = 0;
; 2021 POINTR(R2,TT_ECO) = 0;
; 2022 POINTR(R2,TT_DUM) = $TTLDX;
; 2023 JSYS(0,SFMOD,R1,R2);
; 2024 JSYS(0,STPAR,R1,R2)
; 2025 END;
; 2026 IF .PCPOTP GTR 0
; 2027 THEN
; 2028 BEGIN
; 2029 LOCAL
; 2030 PTR: REF STB_BLK;
; 2031 PTR = .PCPOTP;
; 2032 RETMEM(.PTR[STB_LEN], .PTR, XDICT);
; 2033 PCPOTP = 0
; 2034 END;
; 2035 IF .STRT NEQ 0
; 2036 THEN
; 2037 R1T = .PCCURC[ECB_CFK];
; 2038 IF .STRT EQL 0 THEN R1T = .R1T + SF_CON;
; 2039 R2T = 0;
; 2040 IF NOT
; 2041 BEGIN
; 2042 REGISTER R1=1,R2=2;
; 2043 R1=.R1T;
; 2044 R2=.R2T;
; 2045 JSYS(-1,(IF .STRT EQL 0 THEN SFORK ELSE SFRKV),R1,R2)
; 2046 END
; 2047 THEN
; 2048 ERROR('Unable to start or continue fork')
; 2049 END;
P.AAS: BYTE (7)"U","n","a","b","l" ; Unabl
BYTE (7)"e"," ","t","o"," " ; e to
BYTE (7)"S","P","J","F","N" ; SPJFN
BYTE (7)000,000,000,000,000
P.AAT: BYTE (7)"U","n","a","b","l" ; Unabl
BYTE (7)"e"," ","t","o"," " ; e to
BYTE (7)"s","t","a","r","t" ; start
BYTE (7)" ","o","r"," ","c" ; or c
BYTE (7)"o","n","t","i","n" ; ontin
BYTE (7)"u","e"," ","f","o" ; ue fo
BYTE (7)"r","k",000,000,000 ; rk
REDFRK: PUSH SP,AC12 ; SP,AC12
PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC12,AC1 ; STRT,AC1
HRLI AC4,1 ; HLFTMP,1
MOVE AC1,PCCURC ; AC1,PCCURC
HLR AC4,10(AC1) ; HLFTMP,10(AC1)
HRRZ AC3,4(AC1) ; DESIG,4(AC1)
ADDI AC3,400000 ; DESIG,400000
MOVE AC1,AC4 ; R1,HLFTMP
MOVE AC2,AC3 ; R2,DESIG
JSYS 324 ; 324
JUMP 16,L.163 ; 16,L.163
L.163: HRL AC4,AC3 ; HLFTMP,DESIG
HRR AC4,AC3 ; HLFTMP,DESIG
MOVE AC13,AC4 ; R2T,HLFTMP
MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC14,10(AC1) ; R1T,10(AC1)
MOVE AC1,AC14 ; R1,R1T
MOVE AC2,AC13 ; R2,R2T
JSYS 207 ; 207
JUMP 16,L.164 ; 16,L.164
JRST L.165 ; L.165
L.164: MOVEI AC1,P.AAS ; AC1,P.AAS
PUSHJ SP,PCMXER ; SP,PCMXER
L.165: MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC1,4(AC1) ; R1,4(AC1)
ADDI AC1,400000 ; R1,400000
JSYS 107 ; 107
TRZ AC2,20 ; R2,20
TRZ AC2,4000 ; R2,4000
TRO AC2,14 ; R2,14
JSYS 110 ; 110
JSYS 217 ; 217
SKIPG PCPOTP ; PCPOTP
JRST L.166 ; L.166
MOVE AC2,PCPOTP ; PTR,PCPOTP
HRRZ AC1,0(AC2) ; AC1,0(PTR)
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
SETZM PCPOTP ; PCPOTP
L.166: JUMPE AC12,L.167 ; STRT,L.167
MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC14,10(AC1) ; R1T,10(AC1)
L.167: SETZ AC3, ; AC3,
JUMPN AC12,L.168 ; STRT,L.168
MOVEI AC3,1 ; AC3,1
TLC AC14,400000 ; R1T,400000
L.168: SETZ AC13, ; R2T,
MOVE AC1,AC14 ; R1,R1T
MOVE AC2,AC13 ; R2,R2T
TRNN AC3,1 ; AC3,1
JRST L.169 ; L.169
MOVEI AC3,157 ; AC3,157
JRST L.170 ; L.170
L.169: MOVEI AC3,201 ; AC3,201
L.170: JSYS 0(AC3) ; 0(AC3)
JUMP 16,L.171 ; 16,L.171
JRST L.172 ; L.172
L.171: MOVEI AC1,P.AAT ; AC1,P.AAT
PUSHJ SP,PCMXER ; SP,PCMXER
L.172: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POP SP,AC12 ; SP,AC12
POPJ SP, ; SP,
; Routine Size: 65 words
; 2050
; 2051 GLOBAL ROUTINE PCICLP(KILFRK): NOVALUE = ! Clean up all JFN's and forks
; 2052
; 2053 !++
; 2054 ! Functional description:
; 2055 ! Release all PTY/PDS's; read and forget any unread typeout;
; 2056 ! if a program is being controlled, reset fork to real terminal.
; 2057 ! Release all runtime Parse and I/O JFN's. If requested, kill
; 2058 ! the invoked fork.
; 2059 !
; 2060 ! Formal parameters:
; 2061 ! Nonzero to kill invoked fork
; 2062 !
; 2063 ! Implicit inputs:
; 2064 ! Current Execution Context Block
; 2065 !
; 2066 ! Implicit outputs:
; 2067 ! None
; 2068 !
; 2069 ! Routine value:
; 2070 ! None
; 2071 !
; 2072 ! Side effects:
; 2073 ! None
; 2074 !
; 2075 !--
; 2076
; 2077 BEGIN
; 2078 EXTERNAL REGISTER Z=0;
; 2079 IF (.PCCURC[ECB_DTN] NEQ 0) OR (.PCCURC[ECB_CTN] NEQ 0)
; 2080 THEN
; 2081 BEGIN
; 2082 PCIPSO();
; 2083 IF .PCCURC[ECB_CTN] NEQ 0
; 2084 THEN
; 2085 BEGIN
; 2086 REGISTER R1=1,R2=2;
; 2087 LOCAL
; 2088 HLFTMP: HLF_WRD;
; 2089 R1 = .PCCURC[ECB_CTJ];
; 2090 JSYS(1,CLOSF,R1);
; 2091 HLFTMP[HLF_LFT] = $SCRST;
; 2092 HLFTMP[HLF_RGT] = .PCCURC[ECB_CFK];
; 2093 R1 = .HLFTMP;
; 2094 JSYS(-1,SCTTY,R1,R2);
; L 2095 %IF NOT %VARIANT
; 2096 %THEN
; 2097 R1 = $TTDES + .PCCURC[ECB_CTN];
; 2098 JSYS(1,RELD,R1);
; 2099 %FI
; 2100 R1 = $FHSLF;
; 2101 JSYS(0,GPJFN,R1,R2);
; 2102 R1 = .PCCURC[ECB_CFK];
; 2103 JSYS(-1,SPJFN,R1,R2);
; 2104 PCCURC[ECB_CTN] = 0;
; 2105 PCCURC[ECB_CTJ] = 0
; 2106 END;
; 2107 IF .PCCURC[ECB_DTN] NEQ 0
; 2108 THEN
; 2109 BEGIN
; 2110 REGISTER R1=1;
; L 2111 %IF NOT %VARIANT
; 2112 %THEN
; 2113 R1 = $TTDES + .PCCURC[ECB_DTN];
; 2114 JSYS(1,RELD,R1);
; 2115 %FI
; 2116 R1 = .PCCURC[ECB_DTJ];
; 2117 JSYS(1,CLOSF,R1);
; 2118 PCCURC[ECB_DTN] = 0;
; 2119 PCCURC[ECB_DTJ] = 0
; 2120 END;
; 2121 IF .PCPOTP GTR 0
; 2122 THEN
; 2123 BEGIN
; 2124 LOCAL
; 2125 PTR: REF STB_BLK;
; 2126 PTR = .PCPOTP;
; 2127 RETMEM(.PTR[STB_LEN], .PTR, XDICT);
; 2128 PCPOTP = 0
; 2129 END;
; 2130 IF .PCPEOP GTR 0
; 2131 THEN
; 2132 BEGIN
; 2133 LOCAL
; 2134 PTR: REF STB_BLK;
; 2135 PTR = .PCPEOP;
; 2136 RETMEM(.PTR[STB_LEN], .PTR, XDICT);
; 2137 PCPEOP = 0
; 2138 END
; 2139 END;
; 2140 PCIRPL();
; 2141 DINCLS(0,0);
; 2142 IF .KILFRK NEQ 0 AND .PCCURC[ECB_CFK] NEQ 0 THEN PCIKIF();
; 2143 PCCURC[ECB_CFK] = 0
; 2144 END;
PCICLP::PUSH SP,AC14 ; SP,AC14
MOVE AC14,AC1 ; KILFRK,AC1
MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC2,5(AC1) ; AC2,5(AC1)
JUMPN AC2,L.173 ; AC2,L.173
HRRZ AC2,4(AC1) ; AC2,4(AC1)
JUMPE AC2,L.179 ; AC2,L.179
L.173: PUSHJ SP,PCIPSO ; SP,PCIPSO
MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC2,4(AC1) ; AC2,4(AC1)
JUMPE AC2,L.176 ; AC2,L.176
HLRZ AC1,4(AC1) ; R1,4(AC1)
JSYS 22 ; 22
JFCL ;
HRLI AC3,2 ; HLFTMP,2
MOVE AC2,PCCURC ; AC2,PCCURC
HLR AC3,10(AC2) ; HLFTMP,10(AC2)
MOVE AC1,AC3 ; R1,HLFTMP
JSYS 324 ; 324
JUMP 16,L.174 ; 16,L.174
L.174: MOVE AC3,PCCURC ; AC3,PCCURC
HRRZ AC1,4(AC3) ; R1,4(AC3)
ADDI AC1,400000 ; R1,400000
JSYS 71 ; 71
JFCL ;
MOVEI AC1,400000 ; R1,400000
JSYS 206 ; 206
MOVE AC3,PCCURC ; AC3,PCCURC
HLRZ AC1,10(AC3) ; R1,10(AC3)
JSYS 207 ; 207
JUMP 16,L.175 ; 16,L.175
L.175: MOVE AC1,PCCURC ; AC1,PCCURC
HLLZS 4(AC1) ; 4(AC1)
HRRZS 4(AC1) ; 4(AC1)
L.176: MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC1,5(AC1) ; AC1,5(AC1)
JUMPE AC1,L.177 ; AC1,L.177
ADDI AC1,400000 ; AC1,400000
JSYS 71 ; 71
JFCL ;
MOVE AC2,PCCURC ; AC2,PCCURC
HLRZ AC1,5(AC2) ; R1,5(AC2)
JSYS 22 ; 22
JFCL ;
MOVE AC1,PCCURC ; AC1,PCCURC
HLLZS 5(AC1) ; 5(AC1)
HRRZS 5(AC1) ; 5(AC1)
L.177: SKIPG PCPOTP ; PCPOTP
JRST L.178 ; L.178
MOVE AC2,PCPOTP ; PTR,PCPOTP
HRRZ AC1,0(AC2) ; AC1,0(PTR)
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
SETZM PCPOTP ; PCPOTP
L.178: SKIPG PCPEOP ; PCPEOP
JRST L.179 ; L.179
MOVE AC2,PCPEOP ; PTR,PCPEOP
HRRZ AC1,0(AC2) ; AC1,0(PTR)
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
SETZM PCPEOP ; PCPEOP
L.179: PUSHJ SP,PCIRPL ; SP,PCIRPL
SETZB AC1,AC2 ; AC1,AC2
PUSHJ SP,DINCLS ; SP,DINCLS
JUMPE AC14,L.180 ; KILFRK,L.180
MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC2,10(AC1) ; AC2,10(AC1)
JUMPE AC2,L.180 ; AC2,L.180
PUSHJ SP,PCIKIF ; SP,PCIKIF
L.180: MOVE AC1,PCCURC ; AC1,PCCURC
HRRZS 10(AC1) ; 10(AC1)
POP SP,AC14 ; SP,AC14
POPJ SP, ; SP,
; Routine Size: 73 words
; 2145
; 2146 GLOBAL ROUTINE PCIKIF: NOVALUE = ! Kill invoked fork
; 2147
; 2148 !++
; 2149 ! Functional description:
; 2150 ! Kill the controlled fork (unless it was not Invoked)
; 2151 ! and do away with its PTY.
; 2152 !
; 2153 ! Formal parameters:
; 2154 ! None
; 2155 !
; 2156 ! Implicit inputs:
; 2157 ! ECB_CFK
; 2158 !
; 2159 ! Implicit outputs:
; 2160 ! FORK
; 2161 !
; 2162 ! Routine value:
; 2163 ! None
; 2164 !
; 2165 ! Side effects:
; 2166 ! None
; 2167 !
; 2168 !--
; 2169
; 2170 IF .PCCURC[ECB_CFK] NEQ 0
; 2171 THEN
; 2172 BEGIN
; 2173 EXTERNAL REGISTER Z=0;
; 2174 IF .PCCURC[ECB_CTN] NEQ 0
; 2175 THEN
; 2176 BEGIN
; 2177 PCIPSO();
; 2178 BEGIN
; 2179 REGISTER R1=1,R2=2;
; 2180 LOCAL HLFTMP: HLF_WRD;
; 2181 R1 = .PCCURC[ECB_CTJ];
; 2182 JSYS(1,CLOSF,R1);
; 2183 HLFTMP[HLF_LFT] = $SCRST;
; 2184 HLFTMP[HLF_RGT] = .PCCURC[ECB_CFK];
; 2185 R1 = .HLFTMP;
; 2186 JSYS(-1,SCTTY,R1);
; L 2187 %IF NOT %VARIANT
; 2188 %THEN
; 2189 R1 = $TTDES + .PCCURC[ECB_CTN];
; 2190 JSYS(1,RELD,R1);
; 2191 %FI
; 2192 R1 = $FHSLF;
; 2193 JSYS(0,GPJFN,R1,R2);
; 2194 R1 = .PCCURC[ECB_CFK];
; 2195 JSYS(-1,SPJFN,R1,R2)
; 2196 END;
; 2197 PCCURC[ECB_CTN] = 0;
; 2198 PCCURC[ECB_CTJ] = 0
; 2199 END;
; 2200 IF .PCPOTP GTR 0
; 2201 THEN
; 2202 BEGIN
; 2203 LOCAL
; 2204 PTR: REF STB_BLK;
; 2205 PTR = .PCPOTP;
; 2206 RETMEM(.PTR[STB_LEN], .PTR, XDICT);
; 2207 PCPOTP = 0
; 2208 END;
; 2209 IF .PCCURC[ECB_FNI] EQL 0 THEN KEFORK(.PCCURC[ECB_CFK]);
; 2210 PCCURC[ECB_CFK] = 0
; 2211 END;
PCIKIF::MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC2,10(AC1) ; AC2,10(AC1)
JUMPE AC2,L.186 ; AC2,L.186
HRRZ AC2,4(AC1) ; AC2,4(AC1)
JUMPE AC2,L.183 ; AC2,L.183
PUSHJ SP,PCIPSO ; SP,PCIPSO
MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC1,4(AC1) ; R1,4(AC1)
JSYS 22 ; 22
JFCL ;
HRLI AC3,2 ; HLFTMP,2
MOVE AC2,PCCURC ; AC2,PCCURC
HLR AC3,10(AC2) ; HLFTMP,10(AC2)
MOVE AC1,AC3 ; R1,HLFTMP
JSYS 324 ; 324
JUMP 16,L.181 ; 16,L.181
L.181: MOVE AC2,PCCURC ; AC2,PCCURC
HRRZ AC1,4(AC2) ; R1,4(AC2)
ADDI AC1,400000 ; R1,400000
JSYS 71 ; 71
JFCL ;
MOVEI AC1,400000 ; R1,400000
JSYS 206 ; 206
MOVE AC3,PCCURC ; AC3,PCCURC
HLRZ AC1,10(AC3) ; R1,10(AC3)
JSYS 207 ; 207
JUMP 16,L.182 ; 16,L.182
L.182: MOVE AC1,PCCURC ; AC1,PCCURC
HLLZS 4(AC1) ; 4(AC1)
HRRZS 4(AC1) ; 4(AC1)
L.183: SKIPG PCPOTP ; PCPOTP
JRST L.184 ; L.184
MOVE AC2,PCPOTP ; PTR,PCPOTP
HRRZ AC1,0(AC2) ; AC1,0(PTR)
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
SETZM PCPOTP ; PCPOTP
L.184: MOVE AC2,PCCURC ; AC2,PCCURC
LDB AC1,C.66 ; AC1,[POINT 1,12(AC2),1] <34,1>
JUMPN AC1,L.185 ; AC1,L.185
HLRZ AC1,10(AC2) ; AC1,10(AC2)
PUSHJ SP,KEFORK ; SP,KEFORK
L.185: MOVE AC1,PCCURC ; AC1,PCCURC
HRRZS 10(AC1) ; 10(AC1)
L.186: POPJ SP, ; SP,
C.66: POINT 1,12(AC2),1 ; 1,12(AC2),1
; Routine Size: 46 words
; 2212
; 2213 GLOBAL ROUTINE PCIRPL: NOVALUE = ! Release Parse JFN list
; 2214
; 2215 !++
; 2216 ! Functional description:
; 2217 ! Release all the parsed JFNs and the list itself.
; 2218 !
; 2219 ! Formal parameters:
; 2220 ! Parsed JFN list
; 2221 !
; 2222 ! Implicit inputs:
; 2223 ! None
; 2224 !
; 2225 ! Implicit outputs:
; 2226 ! None
; 2227 !
; 2228 ! Routine value:
; 2229 ! None
; 2230 !
; 2231 ! Side effects:
; 2232 ! None
; 2233 !
; 2234 !--
; 2235
; 2236 IF .PCCURC[ECB_PFL] NEQ 0
; 2237 THEN
; 2238 BEGIN
; 2239 EXTERNAL REGISTER Z=0;
; 2240 LOCAL
; 2241 OLST: REF JLS_WRD, ! List pointers
; 2242 NLST: REF JLS_WRD;
; 2243 OLST = .PCCURC[ECB_PFL];
; 2244 WHILE
; 2245 .OLST NEQ 0
; 2246 DO
; 2247 BEGIN
; 2248 NLST = .OLST[JLS_LNK];
; 2249 BEGIN
; 2250 REGISTER
; 2251 R1=1;
; 2252 R1 = .OLST[JLS_JFN];
; 2253 JSYS(1,RLJFN,R1)
; 2254 END;
; 2255 RETMEM(2, .OLST, XDICT);
; 2256 OLST = .NLST
; 2257 END;
; 2258 PCCURC[ECB_PFL] = 0
; 2259 END;
PCIRPL::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC1,10(AC1) ; AC1,10(AC1)
JUMPE AC1,L.189 ; AC1,L.189
MOVE AC14,AC1 ; OLST,AC1
L.187: JUMPE AC14,L.188 ; OLST,L.188
HRRZ AC13,0(AC14) ; NLST,0(OLST)
MOVE AC1,1(AC14) ; R1,1(OLST)
JSYS 23 ; 23
JFCL ;
MOVEI AC1,2 ; AC1,2
MOVE AC2,AC14 ; AC2,OLST
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
MOVE AC14,AC13 ; OLST,NLST
JRST L.187 ; L.187
L.188: MOVE AC1,PCCURC ; AC1,PCCURC
HLLZS 10(AC1) ; 10(AC1)
L.189: POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 22 words
; 2260
; 2261 GLOBAL ROUTINE PCITIN(PTR,CNT): NOVALUE = ! Type in to user program
; 2262
; 2263 !++
; 2264 ! Functional description:
; 2265 ! Pass provided string to user program, which should be running but
; 2266 ! blocked waiting for input. Once the program receives the input,
; 2267 ! it should continue processing; I wait for the program to either
; 2268 ! halt or require more terminal input. It may be that I am asked
; 2269 ! to type down more than the buffer will accept; in that case I
; 2270 ! write as much as possible, let the program run, and repeat.
; 2271 !
; 2272 ! Formal parameters:
; 2273 ! Pointer to string to input
; 2274 ! Character count of string
; 2275 !
; 2276 ! Implicit inputs:
; 2277 ! None
; 2278 !
; 2279 ! Implicit outputs:
; 2280 ! None
; 2281 !
; 2282 ! Routine value:
; 2283 ! None
; 2284 !
; 2285 ! Side effects:
; 2286 ! None
; 2287 !
; 2288 !--
; 2289
; 2290 BEGIN
; 2291 EXTERNAL REGISTER Z=0;
; 2292 LOCAL
; 2293 PT, ! Pointer
; 2294 CT; ! Count
; 2295 IF .PCCURC[ECB_CFK] EQL 0
; 2296 THEN
; 2297 BEGIN
; 2298 IF .FORK LEQ 0 THEN ERROR('No fork available for typein');
; 2299 PCCURC[ECB_CFK] = .FORK;
; 2300 PCCURC[ECB_FNI] = 1;
; 2301 IF .PCCURC[ECB_CTN] EQL 0
; 2302 THEN
; 2303 BEGIN
; 2304 LOCAL
; 2305 JFN, ! JFN on PDS
; 2306 NUM; ! Number of PDS
; 2307 FNDCTY(JFN,NUM);
; 2308 PCCURC[ECB_CTN] = .NUM;
; 2309 PCCURC[ECB_CTJ] = .JFN
; 2310 END;
; 2311 REDFRK(0)
; 2312 END;
; 2313 PT = .PTR;
; 2314 CT = -.CNT;
; 2315 PCFORK = .FORK; ! Save old value of FORK
; 2316 PCRNFK = .RUNFK; ! and RUNFK
; 2317 IF .PCCURC[ECB_CFK] NEQ 0
; 2318 THEN
; 2319 BEGIN
; 2320 FORK = .PCCURC[ECB_CFK];
; 2321 RUNFK = .PCCURC[ECB_CFK];
; 2322 END;
; 2323 DO
; 2324 BEGIN
; 2325 BEGIN
; 2326 REGISTER
; 2327 R1=1,R2=2,R3=3;
; 2328 R1 = .PCCURC[ECB_CTJ];
; 2329 R2 = .PT;
; 2330 R3 = .CT;
; 2331 JSYS(-1,SOUT,R1,R2,R3);
; 2332 PT = .R2;
; 2333 CT = .R3
; 2334 END;
; 2335 WTFPGM()
; 2336 END
; 2337 UNTIL
; 2338 .CT EQL 0;
; 2339 FORK = .PCFORK;
; 2340 RUNFK = .PCRNFK;
; 2341 PCFORK = -2;
; 2342 PCRNFK = -2;
; 2343 END;
P.AAU: BYTE (7)"N","o"," ","f","o" ; No fo
BYTE (7)"r","k"," ","a","v" ; rk av
BYTE (7)"a","i","l","a","b" ; ailab
BYTE (7)"l","e"," ","f","o" ; le fo
BYTE (7)"r"," ","t","y","p" ; r typ
BYTE (7)"e","i","n",000,000 ; ein
PCITIN::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
ADJSP SP,2 ; SP,2
MOVE AC14,AC2 ; CNT,AC2
MOVE AC13,AC1 ; PTR,AC1
MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC2,10(AC1) ; AC2,10(AC1)
JUMPN AC2,L.192 ; AC2,L.192
SKIPLE FORK ; FORK
JRST L.190 ; L.190
MOVEI AC1,P.AAU ; AC1,P.AAU
PUSHJ SP,PCMXER ; SP,PCMXER
L.190: MOVE AC1,PCCURC ; AC1,PCCURC
MOVE AC2,FORK ; AC2,FORK
HRLM AC2,10(AC1) ; AC2,10(AC1)
MOVSI AC2,200000 ; AC2,200000
IORM AC2,12(AC1) ; AC2,12(AC1)
HRRZ AC2,4(AC1) ; AC2,4(AC1)
JUMPN AC2,L.191 ; AC2,L.191
MOVEI AC1,-1(SP) ; AC1,JFN
MOVEI AC2,0(SP) ; AC2,NUM
PUSHJ SP,FNDCTY ; SP,FNDCTY
MOVE AC1,PCCURC ; AC1,PCCURC
MOVE AC2,0(SP) ; AC2,NUM
HRRM AC2,4(AC1) ; AC2,4(AC1)
MOVE AC2,-1(SP) ; AC2,JFN
HRLM AC2,4(AC1) ; AC2,4(AC1)
L.191: SETZ AC1, ; AC1,
PUSHJ SP,REDFRK ; SP,REDFRK
L.192: MOVN AC14,AC14 ; CT,CNT
MOVE AC1,FORK ; AC1,FORK
MOVEM AC1,PCFORK ; AC1,PCFORK
MOVE AC1,RUNFK ; AC1,RUNFK
MOVEM AC1,PCRNFK ; AC1,PCRNFK
MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC1,10(AC1) ; AC1,10(AC1)
JUMPE AC1,L.193 ; AC1,L.193
MOVEM AC1,FORK ; AC1,FORK
MOVEM AC1,RUNFK ; AC1,RUNFK
L.193: MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC1,4(AC1) ; R1,4(AC1)
MOVE AC2,AC13 ; R2,PT
MOVE AC3,AC14 ; R3,CT
JSYS 53 ; 53
JUMP 16,L.194 ; 16,L.194
L.194: MOVE AC13,AC2 ; PT,R2
MOVE AC14,AC3 ; CT,R3
PUSHJ SP,WTFPGM ; SP,WTFPGM
JUMPN AC14,L.193 ; CT,L.193
MOVE AC1,PCFORK ; AC1,PCFORK
MOVEM AC1,FORK ; AC1,FORK
MOVE AC1,PCRNFK ; AC1,PCRNFK
MOVEM AC1,RUNFK ; AC1,RUNFK
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,PCFORK ; AC1,PCFORK
HRROI AC1,-2 ; AC1,-2
MOVEM AC1,PCRNFK ; AC1,PCRNFK
ADJSP SP,-2 ; SP,-2
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
; Routine Size: 61 words
; 2344
; 2345 ROUTINE WTFPGM = ! Wait for program to require PCL
; 2346
; 2347 !++
; 2348 ! Functional description:
; 2349 ! Continue user program, and wait for it to either halt, die,
; 2350 ! or read from its controlling PTY/PDS.
; 2351 !
; 2352 ! Formal parameters:
; 2353 ! None
; 2354 !
; 2355 ! Implicit inputs:
; 2356 ! None
; 2357 !
; 2358 ! Implicit outputs:
; 2359 ! None
; 2360 !
; 2361 ! Routine value:
; 2362 ! None
; 2363 !
; 2364 ! Side effects:
; 2365 ! None
; 2366 !
; 2367 !--
; 2368
; 2369 BEGIN
; 2370 EXTERNAL REGISTER Z=0;
; 2371 PCPRGR = -1;
; 2372 PCMWTF();
; 2373 ! Be aware that if the fork gets an error EXECP will issue an ERROR
; 2374 PCPRGR = 0
; 2375 END;
WTFPGM: SETOM PCPRGR ; PCPRGR
PUSHJ SP,PCMWTF ; SP,PCMWTF
SETZB AC1,PCPRGR ; AC1,PCPRGR
POPJ SP, ; SP,
; Routine Size: 4 words
; 2376
; 2377 GLOBAL ROUTINE PCIPEO: NOVALUE = ! Prepare for Exec output
; 2378
; 2379 !++
; 2380 ! Functional description:
; 2381 ! Make sure PCL has a PDS for DoCommand output, initialize an
; 2382 ! output buffer, so the PTY reader knows where to put the output.
; 2383 ! Keeps information on this PDS in ECB.
; 2384 !
; 2385 ! Formal parameters:
; 2386 ! None
; 2387 !
; 2388 ! Implicit inputs:
; 2389 ! Current Execution Context Block
; 2390 !
; 2391 ! Implicit outputs:
; 2392 ! None
; 2393 !
; 2394 ! Routine value:
; 2395 ! None
; 2396 !
; 2397 ! Side effects:
; 2398 ! None
; 2399 !
; 2400 !--
; 2401
; 2402 BEGIN
; 2403 EXTERNAL REGISTER Z=0;
; 2404 LOCAL
; 2405 PTR: REF STB_BLK, ! String block
; 2406 JFN, ! JFN on PDS
; 2407 NUM; ! Number of PDS
; 2408 IF .PCCURC[ECB_DTN] NEQ 0 THEN RETURN;
; 2409 FNDCTY(JFN,NUM);
; 2410 PCCURC[ECB_DTN] = .NUM;
; 2411 PCCURC[ECB_DTJ] = .JFN;
; 2412 PTR = PCMGMM(10, XDICT);
; 2413 PTR[STB_CNT] = 0;
; 2414 PTR[STB_LEN] = 10;
; 2415 PCPEOP = .PTR
; 2416 END;
PCIPEO::ADJSP SP,2 ; SP,2
MOVE AC1,PCCURC ; AC1,PCCURC
HRRZ AC2,5(AC1) ; AC2,5(AC1)
JUMPN AC2,L.195 ; AC2,L.195
MOVEI AC1,-1(SP) ; AC1,JFN
MOVEI AC2,0(SP) ; AC2,NUM
PUSHJ SP,FNDCTY ; SP,FNDCTY
MOVE AC1,PCCURC ; AC1,PCCURC
MOVE AC2,0(SP) ; AC2,NUM
HRRM AC2,5(AC1) ; AC2,5(AC1)
MOVE AC2,-1(SP) ; AC2,JFN
HRLM AC2,5(AC1) ; AC2,5(AC1)
MOVEI AC1,12 ; AC1,12
MOVEI AC2,XDICT ; AC2,XDICT
PUSHJ SP,PCMGMM ; SP,PCMGMM
HRRZS 0(AC1) ; 0(PTR)
MOVEI AC2,12 ; AC2,12
HRRM AC2,0(AC1) ; AC2,0(PTR)
MOVEM AC1,PCPEOP ; PTR,PCPEOP
L.195: ADJSP SP,-2 ; SP,-2
POPJ SP, ; SP,
; Routine Size: 21 words
; 2417
; 2418 GLOBAL ROUTINE PCIPSO: NOVALUE = ! Handle controller pseudointerrupt
; 2419
; 2420 !++
; 2421 ! Functional description:
; 2422 ! Entered when PTY/PDS-output PSI occurs. Reads all pending output
; 2423 ! from the PDS's and saves them in their standard string blocks.
; 2424 !
; 2425 ! Formal parameters:
; 2426 ! None
; 2427 !
; 2428 ! Implicit inputs:
; 2429 ! PTY/PDS, current Execution Context Block
; 2430 !
; 2431 ! Implicit outputs:
; 2432 ! None
; 2433 !
; 2434 ! Routine value:
; 2435 ! None
; 2436 !
; 2437 ! Side effects:
; 2438 ! Disables interrupts while running
; 2439 !
; 2440 !--
; 2441
; 2442 BEGIN
; 2443 EXTERNAL REGISTER Z=0;
; 2444 LOCAL
; 2445 CNT, ! Character count
; 2446 TBL, ! Address of block pointer being updated
; 2447 PECB: REF ECB_BLK, ! ECB doing DoCommand To
; 2448 PTR: REF STB_BLK; ! Output buffer pointer
; 2449 BEGIN
; 2450 REGISTER R1=1;
; 2451 R1 = $FHSLF;
; 2452 JSYS(0,DIR,R1)
; 2453 END;
; 2454 PECB = .PCCURC;
; 2455 WHILE
; 2456 .PECB NEQ 0 AND .PECB[ECB_DTO] EQL %O'777777'
; 2457 DO
; 2458 PECB = .PECB[ECB_NXT];
; 2459 DECR I FROM (IF .PECB NEQ 0 THEN 1 ELSE 0) DO
; 2460 BEGIN
; 2461 WHILE
; 2462 BEGIN
; 2463 REGISTER R1=1,R2=2;
; 2464 IF .I NEQ 0
; 2465 THEN
; 2466 R1 = $TTDES + .PECB[ECB_DTN]
; 2467 ELSE
; 2468 R1 = $TTDES + .PCCURC[ECB_CTN];
; 2469 IF JSYS(1,SOBE,R1,R2) THEN R2 = 0;
; 2470 CNT = .R2
; 2471 END
; 2472 NEQ 0
; 2473 DO
; 2474 BEGIN
; 2475 TBL = (IF .I NEQ 0 THEN PCPEOP ELSE PCPOTP);
; 2476 PTR = ..TBL;
; 2477 IF .PTR EQL 0
; 2478 THEN
; 2479 BEGIN
; 2480 PTR = PCMGME( (.CNT+100)/5, XDICT);
; 2481 IF .PTR NEQ 0
; 2482 THEN
; 2483 BEGIN
; 2484 PTR[STB_CNT] = 0;
; 2485 PTR[STB_LEN] = (.CNT+100)/5
; 2486 END
; 2487 ELSE
; 2488 PTR = -1;
; 2489 .TBL = .PTR;
; 2490 END
; 2491 ELSE
; 2492 IF .PTR GTR 0
; 2493 THEN
; 2494 BEGIN
; 2495 IF (.PTR[STB_LEN]-1)*5-.PTR[STB_CNT] LSS .CNT
; 2496 THEN
; 2497 BEGIN
; 2498 LOCAL
; 2499 NEW: REF STB_BLK;
; 2500 NEW = PCMGME( (.PTR[STB_CNT]+.CNT+100)/5, XDICT);
; 2501 IF .NEW NEQ 0
; 2502 THEN
; 2503 BEGIN
; 2504 NEW[STB_LEN] = (.PTR[STB_CNT]+.CNT+100)/5;
; 2505 NEW[STB_CNT] = .PTR[STB_CNT];
; 2506 CH$MOVE(.PTR[STB_CNT], BYTPTR(PTR[STB_BUF]),
; 2507 BYTPTR(NEW[STB_BUF]))
; 2508 END
; 2509 ELSE
; 2510 NEW = -1;
; 2511 RETMEM(.PTR[STB_LEN], .PTR, XDICT);
; 2512 .TBL = .NEW;
; 2513 PTR = .NEW
; 2514 END
; 2515 END;
; 2516 BEGIN
; 2517 REGISTER
; 2518 R1=1,R2=2,R3=3;
; 2519 R1 = (IF .I NEQ 0 THEN .PECB[ECB_DTJ] ELSE .PCCURC[ECB_CTJ]);
; 2520 IF .PTR GTR 0
; 2521 THEN
; 2522 R2 = CH$PTR(PTR[STB_BUF],.PTR[STB_CNT])
; 2523 ELSE
; 2524 R2 = $NULIO;
; 2525 R3 = - .CNT;
; 2526 JSYS(0,SIN,R1,R2,R3);
; 2527 IF .PTR GTR 0 THEN PTR[STB_CNT] = .PTR[STB_CNT] + .CNT
; 2528 END;
; 2529 IF .PCCURC[ECB_PAS] AND .PCPOTP NEQ 0
; 2530 THEN
; 2531 BEGIN
; 2532 PTR = .PCPOTP;
; 2533 PCPOTP = 0;
; 2534 BEGIN
; 2535 REGISTER R1=1,R2=2,R3=3;
; 2536 R1 = .COJFN;
; 2537 R2 = BYTPTR(PTR[STB_BUF]);
; 2538 R3 = -.PTR[STB_CNT];
; 2539 JSYS(0,SOUT,R1,R2,R3)
; 2540 END;
; 2541 RETMEM(.PTR[STB_LEN], .PTR, XDICT)
; 2542 END
; 2543 END
; 2544 END;
; 2545 BEGIN
; 2546 REGISTER R1=1;
; 2547 R1 = $FHSLF;
; 2548 JSYS(0,EIR,R1)
; 2549 END
; 2550 END;
PCIPSO::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,4 ; SP,4
MOVEI AC1,400000 ; R1,400000
JSYS 130 ; 130
MOVE AC13,PCCURC ; PECB,PCCURC
L.196: JUMPE AC13,L.198 ; PECB,L.198
HLRZ AC1,6(AC13) ; AC1,6(PECB)
CAIE AC1,-1 ; AC1,-1
JRST L.197 ; L.197
HRRZ AC13,0(AC13) ; PECB,0(PECB)
JRST L.196 ; L.196
L.197: JUMPE AC13,L.198 ; PECB,L.198
MOVEI AC1,1 ; AC1,1
MOVEM AC1,-1(SP) ; AC1,-1(SP)
JRST L.199 ; L.199
L.198: SETZM -1(SP) ; -1(SP)
L.199: AOS -1(SP) ; -1(SP)
JRST L.217 ; L.217
L.200: SKIPN -1(SP) ; I
JRST L.201 ; L.201
HRRZ AC1,5(AC13) ; R1,5(PECB)
JRST L.202 ; L.202
L.201: MOVE AC2,PCCURC ; AC2,PCCURC
HRRZ AC1,4(AC2) ; R1,4(AC2)
L.202: ADDI AC1,400000 ; R1,400000
JSYS 103 ; 103
JRST L.203 ; L.203
SETZ AC2, ; R2,
L.203: MOVEM AC2,0(SP) ; R2,CNT
SKIPN 0(SP) ; CNT
JRST L.217 ; L.217
SETZM -3(SP) ; -3(SP)
SKIPN -1(SP) ; I
JRST L.204 ; L.204
MOVEI AC1,1 ; AC1,1
MOVEM AC1,-3(SP) ; AC1,-3(SP)
MOVEI AC1,PCPEOP ; AC1,PCPEOP
JRST L.205 ; L.205
L.204: MOVEI AC1,PCPOTP ; AC1,PCPOTP
L.205: MOVEM AC1,-2(SP) ; AC1,TBL
MOVE AC14,0(AC1) ; PTR,0(AC1)
JUMPN AC14,L.208 ; PTR,L.208
MOVE AC12,0(SP) ; AC12,CNT
ADDI AC12,144 ; AC12,144
MOVE AC1,AC12 ; AC1,AC12
IDIVI AC1,5 ; AC1,5
MOVE AC12,AC1 ; AC12,AC1
MOVEI AC2,XDICT ; AC2,XDICT
PUSHJ SP,PCMGME ; SP,PCMGME
MOVE AC14,AC1 ; PTR,AC1
JUMPE AC14,L.206 ; PTR,L.206
HRRZS 0(AC14) ; 0(PTR)
HRRM AC12,0(AC14) ; AC12,0(PTR)
JRST L.207 ; L.207
L.206: SETO AC14, ; PTR,
L.207: MOVE AC1,-2(SP) ; AC1,TBL
MOVEM AC14,0(AC1) ; PTR,0(AC1)
JRST L.211 ; L.211
L.208: JUMPLE AC14,L.211 ; PTR,L.211
HRRZ AC1,0(AC14) ; AC1,0(PTR)
IMULI AC1,5 ; AC1,5
HLRZ AC11,0(AC14) ; AC11,0(PTR)
SUB AC1,AC11 ; AC1,AC11
SUBI AC1,5 ; AC1,5
CAML AC1,0(SP) ; AC1,CNT
JRST L.211 ; L.211
MOVE AC1,AC11 ; AC1,AC11
ADD AC1,0(SP) ; AC1,CNT
MOVE AC10,AC1 ; AC10,AC1
ADDI AC10,144 ; AC10,144
MOVE AC1,AC10 ; AC1,AC10
IDIVI AC1,5 ; AC1,5
MOVE AC10,AC1 ; AC10,AC1
MOVEI AC2,XDICT ; AC2,XDICT
PUSHJ SP,PCMGME ; SP,PCMGME
MOVE AC12,AC1 ; NEW,AC1
JUMPE AC12,L.209 ; NEW,L.209
HRRM AC10,0(AC12) ; AC10,0(NEW)
HRLM AC11,0(AC12) ; AC11,0(NEW)
MOVE AC2,AC14 ; HLF,PTR
ADDI AC2,1 ; HLF,1
HRLI AC2,-337100 ; HLF,-337100
MOVE AC3,AC12 ; HLF,NEW
ADDI AC3,1 ; HLF,1
HRLI AC3,-337100 ; HLF,-337100
MOVE AC1,AC11 ; AC1,AC11
MOVE AC4,AC11 ; AC4,AC11
MOVE AC5,AC3 ; AC5,HLF
EXTEND AC1,C.8 ; AC1,[MOVSLJ ]
JFCL ;
JRST L.210 ; L.210
L.209: SETO AC12, ; NEW,
L.210: HRRZ AC1,0(AC14) ; AC1,0(PTR)
MOVE AC2,AC14 ; AC2,PTR
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
MOVE AC1,-2(SP) ; AC1,TBL
MOVEM AC12,0(AC1) ; NEW,0(AC1)
MOVE AC14,AC12 ; PTR,NEW
L.211: MOVEI AC1,1 ; AC1,1
TDNN AC1,-3(SP) ; AC1,-3(SP)
JRST L.212 ; L.212
HLRZ AC1,5(AC13) ; R1,5(PECB)
JRST L.213 ; L.213
L.212: MOVE AC1,PCCURC ; AC1,PCCURC
HLRZ AC1,4(AC1) ; R1,4(AC1)
L.213: JUMPLE AC14,L.214 ; PTR,L.214
MOVEI AC3,1(AC14) ; AC3,1(PTR)
HRLI AC3,-337100 ; AC3,-337100
HLRZ AC2,0(AC14) ; AC2,0(PTR)
ADJBP AC2,AC3 ; AC2,AC3
JRST L.215 ; L.215
L.214: MOVEI AC2,377777 ; R2,377777
L.215: MOVN AC3,0(SP) ; R3,CNT
JSYS 52 ; 52
JUMPLE AC14,L.216 ; PTR,L.216
HLRZ AC1,0(AC14) ; AC1,0(PTR)
ADD AC1,0(SP) ; AC1,CNT
HRLM AC1,0(AC14) ; AC1,0(PTR)
L.216: MOVE AC1,PCCURC ; AC1,PCCURC
MOVSI AC2,20000 ; AC2,20000
TDNE AC2,12(AC1) ; AC2,12(AC1)
SKIPN PCPOTP ; PCPOTP
JRST L.200 ; L.200
MOVE AC14,PCPOTP ; PTR,PCPOTP
SETZM PCPOTP ; PCPOTP
MOVE AC1,COJFN ; R1,COJFN
MOVE AC2,AC14 ; HLF,PTR
ADDI AC2,1 ; HLF,1
HRLI AC2,-337100 ; HLF,-337100
HLRZ AC4,0(AC14) ; AC4,0(PTR)
MOVN AC3,AC4 ; R3,AC4
JSYS 53 ; 53
HRRZ AC1,0(AC14) ; AC1,0(PTR)
MOVE AC2,AC14 ; AC2,PTR
MOVEI AC3,XDICT ; AC3,XDICT
PUSHJ SP,RETMEM ; SP,RETMEM
JRST L.200 ; L.200
L.217: SOSL -1(SP) ; I
JRST L.200 ; L.200
MOVEI AC1,400000 ; R1,400000
JSYS 126 ; 126
ADJSP SP,-4 ; SP,-4
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: 153 words
; 2551
; 2552 GLOBAL ROUTINE PCIDPY(ADR,LEN,FLG,TYP): NOVALUE = ! Display on real terminal
; 2553
; 2554 !++
; 2555 ! Functional description:
; 2556 ! Prints string or integer on real terminal.
; 2557 !
; 2558 ! Formal parameters:
; 2559 ! Integer or address of string to display
; 2560 ! Length of string (currently ignored for integers)
; 2561 ! Flag: 0=Normal, 1=Binary, -1=Normal without CRLF
; 2562 ! Type of value being displayed: GST_TYP_INT or GST_TYP_STR
; 2563 !
; 2564 ! Implicit inputs:
; 2565 ! None
; 2566 !
; 2567 ! Implicit outputs:
; 2568 ! None
; 2569 !
; 2570 ! Routine value:
; 2571 ! None
; 2572 !
; 2573 ! Side effects:
; 2574 ! None
; 2575 !
; 2576 !--
; 2577
; 2578 BEGIN
; 2579 EXTERNAL REGISTER Z=0;
; 2580 LOCAL
; 2581 SAVMODE;
; 2582 REGISTER R1=1,R2=2,R3=3;
; 2583 R1 = .COJFN;
; 2584 IF .FLG GTR 0
; 2585 THEN
; 2586 BEGIN
; 2587 JSYS(0,RFMOD,R1,R2);
; 2588 SAVMODE = .R2;
; 2589 POINTR(R2,TT_DAM) = 0;
; 2590 JSYS(0,SFMOD,R1,R2)
; 2591 END;
; 2592 IF .TYP EQL GST_TYP_STR
; 2593 THEN ! String
; 2594 BEGIN
; 2595 R2 = BYTPTR(.ADR);
; 2596 R3 = .LEN;
; 2597 JSYS(0,SOUT,R1,R2,R3)
; 2598 END
; 2599 ELSE ! Integer
; 2600 BEGIN
; 2601 R2 = .ADR;
; 2602 R3 = FLD(10,NO_RDX);
; 2603 JSYS(-1,NOUT,R1,R2,R3);
; 2604 END;
; 2605 IF .FLG EQL 0
; 2606 THEN
; 2607 BEGIN
; 2608 R2 = CH$PTR(UPLIT(%CHAR($CHCRT,$CHLFD)));
; 2609 R3 = -2;
; 2610 JSYS(0,SOUT,R1,R2,R3)
; 2611 END;
; 2612 IF .FLG GTR 0
; 2613 THEN
; 2614 BEGIN
; 2615 R2 = .SAVMODE;
; 2616 JSYS(0,SFMOD,R1,R2)
; 2617 END;
; 2618 BEGIN
; 2619 JSYS(0,RFPOS,R1,R2);
; 2620 PCCURC[ECB_POS] = .R2
; 2621 END
; 2622 END;
P.AAV: BYTE (7)015,012,000,000,000
PCIDPY::PUSH SP,AC13 ; SP,AC13
PUSH SP,AC14 ; SP,AC14
MOVE AC16,AC3 ; FLG,AC3
MOVE AC14,AC2 ; LEN,AC2
MOVE AC5,AC1 ; ADR,AC1
MOVE AC1,COJFN ; R1,COJFN
JUMPLE AC16,L.218 ; FLG,L.218
JSYS 107 ; 107
MOVE AC13,AC2 ; SAVMODE,R2
TRZ AC2,300 ; R2,300
JSYS 110 ; 110
L.218: CAIE AC4,1 ; TYP,1
JRST L.219 ; L.219
MOVE AC3,AC5 ; HLF,ADR
HRLI AC3,-337100 ; HLF,-337100
MOVE AC2,AC3 ; R2,HLF
MOVE AC3,AC14 ; R3,LEN
JSYS 53 ; 53
JRST L.220 ; L.220
L.219: MOVE AC2,AC5 ; R2,ADR
MOVEI AC3,12 ; R3,12
JSYS 224 ; 224
JUMP 16,L.220 ; 16,L.220
L.220: JUMPN AC16,L.221 ; FLG,L.221
MOVE AC2,C.67 ; R2,[POINT 7,P.AAV-1,34] <1,7>
HRROI AC3,-2 ; R3,-2
JSYS 53 ; 53
L.221: JUMPLE AC16,L.222 ; FLG,L.222
MOVE AC2,AC13 ; R2,SAVMODE
JSYS 110 ; 110
L.222: JSYS 111 ; 111
MOVE AC1,PCCURC ; AC1,PCCURC
MOVEM AC2,1(AC1) ; R2,1(AC1)
POP SP,AC14 ; SP,AC14
POP SP,AC13 ; SP,AC13
POPJ SP, ; SP,
C.67: POINT 7,P.AAV-1,34 ; 7,P.AAV-1,34
; Routine Size: 37 words
; 2623
; 2624 END
; 2625 ELUDOM
END
; Low segment length: 0 words
; High segment length: 1919 words
; LIBRARY STATISTICS
;
; -------- Symbols -------- Blocks
; File Total Loaded Percent Read
;
; PK:<PA0B>EXECPD.L36.9 306 89 29 0
; PS:<BLISS>TENDEF.L36.5 56 6 10 0
; PS:<BLISS>MONSYM.L36.10 4077 97 2 0
; Information: 0
; Warnings: 3
; Errors: 0
; Compilation Complete
END