TITLE 'WMAQ-B00,08/22/73,DWG702985' SYSTEM SIG7F CSECT 1 PCC 0 CONTROL CARDS NOT PRINTED. WMAQ@ RES 0 ORIGIN OF WORKSPACE MGMT & ACQUISITION MODULE. * * REF'S AND DEF'S * DEF WMAQ@ = START OF WMAQ MODULE. DEF ALOCRS ALLOCATES A 'RESULT' DATA BLK. DEF ALOCNONX NON-EXEC. ALLOCS., CALLS 'ALOCHNW'. DEF ALOCHNW ALLOCS. N WDS + 2-WD HDR + 1 IF ODD. DEF ALOCTRES ALLOCATES A TEXT 'RESULT' DATA BLK. DEF ALOCBLK ALLOCS. DATA BLK, SETS SIZE & REF=1. DEF GIVEBACK GIVE TAIL OF D.B. BACK TO FREE TBL. DEF CKVDB CK STRUCTURE OF VAR. DATA BLK. DEF WSCHEK CK WS (DIAG. TOOL) DEF WSCKDSPL CK WS STRUCT., DISPLACING DB PTRS * BY THE DYNAMIC OFFSET FOR THE WS * WHEN SAVED VS. WHEN LOADED. DEF CTEST TRIES TO GET MORE COMMON. DEF SICLR CLEARS STATE-INDICATOR TO GO-STATE. DEF SICLR% (ALTERNATE ENTRY TO SICLR). DEF MAYDREF DE-REFS DATA BLK IF 1 IS POINTED TO. DEF DREF DE-REFERENCES DATA BLK PT'ED TO. DEF GARBCOLL GARBAGE COLLECTOR. DEF ACQNAME ACQUIRES A NAME, PUTS NEW IN SYM TBL DEF HASHINC HASH INCREMENT (SEE COPY CMD 'HASH') DEF FINDNAME FINDS NAME IF IN SYMBOL TABLE DEF IN2CODE INTERNAL CHAR'S CODE BYTE TABLE. DEF ACQNXCC ACQ NEXT INTERNAL CHAR & ITS CODE. DEF ACQCC ACQ CURRENT CHAR & ITS CODE. DEF ACQCODE ACQ CODE OF CURRENT CHAR. DEF ACQNXNB ACQ NEXT NON-BLANK & ITS CODE. DEF ACQNB ACQ NON-BLANK & ITS CODE. DEF ACQIT ACQ NAME OR NUMERIC ITEM. * REFS TO PROCEDURE: REF GETDYN GETS MORE DYNAMIC PAGES. REF GETCOM GETS 1 MORE PAGE OF COMMON. REF ERWSFUL ERROR -- WORKSPACE FULL. REF SYSTERR ERROR -- SYSTEM ERROR. * REFS TO CONTEXT: REF DYNBOUND UPPER BOUND FOR DYNAMIC REGION. REF STKLIMIT CURRENT LIMIT FOR EXECUTION STACK. REF LOCNEED NEW LOC. NEEDED WHEN OVER STACK LIMT REF CORLEFT ZERO IF NO MORE PAGES AVAILABLE. REF NEWBOUND NEW UPPER BOUND NEEDED FOR DYNAMIC. REF SYMT PTS AT 1ST WD OF SYMBOL TABLE. REF SYMTSIZE NO.OF ENTRYS FOR SYMBOL TABLE. REF NSYMTWDS NO.OF WORDS IN SYMBOL TABLE. REF NAMEBUF BUFFER TO HOLD ACQUIRED NAME. REF NAMEWDS TEMP TO HOLD # WDS CONTAINING A NAME REF NAMLIMIT = MAX # CHARS USED FOR A NAME. REF NAMEWDSZ = MAX # WDS USED TO CONTAIN A NAME. REF FREETOTL TOTAL SPACE CONTAINED IN FREE TABLE. REF FREETBL FREE TABLE (2-WD ENTRIES--LOC & AMT) REF MAXFRENS MAX NO.OF FREE TABLE ENTRIES. REF FBOUNDS HOLDS FREE-BLK BOUNDS FOR GARB.COLL. REF FAQMS HOLDS FREE-ACCUMULATIONS TO FBOUNDS. REF NR2MOVE NO.OF REGIONS TO MOVE IN GARB.COLL. REF BLKWANTD HOLDS SIZE OF NEW DATA BLK WANTED. REF RESULT PTR TO 'RESULT' DATA BLK. REF RSRANK RANK FOR 'RESULT' DATA BLK. REF RSTYPE TYPE FOR 'RESULT' DATA BLK. REF STRAYS AREA FOR STRAY DATA BLK PTRS. REF STRAYBLK TOTAL SIZE OF STRAY DATA BLK PTR SET REF DBROOT IF NZ, PTS AT ROOT DB FOR LIST-FDEF. REF DBSERIES PTR INTO A LIST OR FUN. DESCPIPTOR. REF CURRCS PTR TO CODESTRING DATA BLK (+2) REF DREFSAVE SAVE REGS DURING DE-REFERENCING. REF GARBSAVE SAVE REGS FOR GARBAGE COLLECT, ET AL REF GCTEMP TEMP FOR GARBAGE COLLECT. REF LINKGC LINK TO GARBAGE COLLECTOR. REF LINKWS LINK FOR WORKSPACE MGMT ROUTINES. REF TOPOSTAK PTS AT TOP OF EXECUTION STACK. REF STATEPTR PTS AT TOP STATE-ENTRY IN STACK. REF GOSTATE PTS AT GO-STATE ENTRY IN STACK. * REFS TO CONSTANTS: REF X1FFFF X'1FFFF' REF ZEROZERO 0,0 REF BLANKS WD CONTAINING ALL BLANKS. REF NONAME RANGE THAT EXCLUDES NAME-CHAR CODES. REF FUNTYPES RANGE OF FUN.DESCRIPTOR D.B. TYPES. REF BITPOS 32-WD TBL OF BITS (BITPOS-K CONTAINS * A WD HAVING A 1 ONLY IN BIT POS K) * * EQU'S RELATED TO CONTEXT * HASHAQM EQU NAMEWDS PARTIAL HASH VALUE ACCUMULATOR. * * STANDARD EQU'S * REGISTERS R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 * * OTHER EQU'S * STOPNMCD EQU 21 STOPNAME CODESTRING DESIGNATOR. NAMECODE EQU 23 ORDINARY NAME CODESTRING DESIGNATOR. LASTCSV EQU 138 LAST CODESTRING DESIGNATOR, CODES * ABOVE THIS VALUE ARE FOR THE * NAME-START CHARS. DELTA EQU X'48' DELTA CHAR (EBCDIC MAPPING). HASHINC EQU 32 HASHING INCREMENT ON HASH-CRASH. TOPRANK EQU 63 MAX. ALLOWED RANK. TYPEXSEQ EQU 5 TYPE FOR INDEX-SEQUENCE DATA BLKS. TYPELIST EQU 6 SIGNIFIES LIST TYPE DATA BLOCKS. TYPLONGN EQU X'12' SIGNIFIES LONG-NAME TYPE DATA BLKS. CATLC EQU 11 LINE-CHAIN CATEGORY OF STACK ENTRY. LISTLOFF EQU 2 OFFSET FROM LIST DB HDR TO LENGTH WD XSIZOFF EQU 2 OFFSET TO FUN.DESCRS. XSIZE WD. NFLOFF EQU 7 OFFSET FROM FUN.DESCR. HDR TO THE * WD CONTAINING NO.OF FUNCTION LINES TRNKXSEQ EQU X'0501' TYPE & RANK OF INDEX-SEQ. DATA BLK. * * DOUBLEWORD CONSTANTS * BOUND 8 SANDT DATA 'S','T' USED IN TESTING FOR STOP OR TRACE. * * WORD CONSTANTS * MINUS2 DATA X'FFFFFFFE' ALL BUT LAST BIT POSITION. PAGE ************************************************************************ * * * ALLOCATION REQUEST ROUTINES: * * * * ALOCRS -- ALLOCATES A DATA BLOCK FOR THE RESULT OF AN OPERATION. * * IT SETS 'RESULT' TO PT AT THAT BLOCK AND PLANTS TYPE (GIVEN * * BY 'RSTYPE') AND RANK (VIA 'RSRANK') IN THE HEADER. SEE ALSO * * 'ALOCBLK' FOR SIZE AND REF-COUNT SETTINGS. * * ALOCTRES -- ENTRY PT UNDER ALOCRS FOR TEXT TYPE DATA BLK. * * REGS: R11 (ENTRY) NO.OF ELEMENTS (BITS, BYTES, WDS, OR * * DBLWDS) NEEDED FOR RESULT. * * R14 LINK, EXIT VIA *R14. * * R4 (EXIT) ALSO PTS AT NEW DATA BLOCK. * * R7 AND R11 ARE VOLATILE; SEE ALSO 'ALOCBLK'. * * * * ALOCNONX -- ALLOCATES SPACE FOR NON-EXECUTION PROCESSES, USING * * ALOCHNW. LINK IS R14: RETURN+0 IF WS FULL & RETURN+1 IF OK. * * * * ALOCHNW -- ALLOCATES A DATA BLOCK OF N WDS + 2 WDS FOR HDR + AN * * EXTRA WD IF NECESSARY TO REACH AN EVEN NO. SEE ALSO 'ALOCBLK'* * REGS: R11 (ENTRY) N WDS REQUESTED, NOT COUNTING HDR, NOT * * NECESSARILY AN EVEN NO. * * R11 IS CLOBBERED; SEE ALSO 'ALOCBLK'. * * R7 LINK; EXIT IS IN 'ALOCBLK'. * * * * ALOCBLK -- ALLOCATES A DATA BLOCK, SETS ITS SIZE FIELD, AND SETS * * ITS REF-COUNT TO ONE. * * REGS: R11 (ENTRY) SIZE OF BLOCK WANTED, MUST BE EVEN NO. * * R7 LINK, EXIT VIA 0,R7 * * R4 (EXIT) PTS AT FIRST WD OF NEW DATA BLOCK. * * R5, R10, AND R11 ARE VOLATILE. * * * ALOCNONX BAL,R7 ALOCHNW ALLOC. HDR + N WDS & EVEN SIZE... AI,R14 1 OK, SET RETURN+1. B *R14 (IF WS FULL, ALOCBLK EXITS HERE) * ALOCRS LW,R4 RSTYPE VECTOR ON THE TYPE OF RESULT... TYPER B TYPER,R4 0 -- IMPOSSIBLE @ B LOGL 1 -- LOGICAL @ B TEXT 2 -- CHARACTER @ B UPRANK 3 -- INTEGER, ERGO WDS. @ B REAL 4 -- REAL, ERGO DBLWDS. @ B XSEQ 5 -- XSEQ (INDEX SEQUENCE) @ B UPRANK 6 -- LIST, ERGO WDS. @ REAL SLS,R11 1 UPRANK AW,R11 RSRANK DATA BLK NEEDS 1 WD PER DIMENSION. LI,R7 SETRS RETURN TO 'SETRS' AFTER GETTING BLK. ALOCHNW AI,R11 2 2 WDS NEEDED FOR THE HEADER CI,R11 1 CK FOR EVEN NO.OF WDS... BAZ ALOCBLK YEP, OK. AI,R11 1 NOPE, GET AN EXTRA WD. ALOCBLK STW,R11 BLKWANTD SAVE TOTAL BLK SIZE WANTED. RETRY SW,R11 FREETOTL IS THAT MUCH FREE CURRENTLY... BLEZ FRETSET YES -- SEARCH THE FREE TABLE. STW,R8 LINKWS NO, SAVE R8. BAL,R8 GARBCOLL DO GARBAGE COLLECTION. LW,R8 LINKWS RESTORE R8. LW,R10 CORLEFT ARE MORE PAGES AVAILABLE... BEZ OLAP NO -- TRY TO OVERLAP INTO COMMON. AW,R11 DYNBOUND YES, CALC. HI NEEDED DYNAMIC BOUND STW,R11 NEWBOUND (WE'LL PROBABLY GET MUCH MORE). LCW,R11 DYNBOUND = - THE 'OLD' BOUND. BAL,R14 GETDYN GET NEW DYNAMIC PAGE OR PAGES. LW,R14 GARBSAVE+14 NOTE--GARBCOLL SAVED R14 HERE, SO THIS OK. AW,R11 DYNBOUND CALC SIZE = 'NEW' - 'OLD' BOUNDS. AWM,R11 FREETOTL ADD THAT SIZE INTO THE FREE TABLE. AWM,R11 FREETBL+1 LW,R11 BLKWANTD GET SIZE WANTED (WE MAY NOT SUCCEED) B RETRY OLAP LW,R11 TOPOSTAK CALC. SPACE BETWEEN STACK & LAST SW,R11 FREETBL DYNAMIC WD IN USE. SW,R11 BLKWANTD = SPACE LEFT OVER AFTER THE NEW BLK. SAS,R11 -2 DIVIDE BY 4 (4 IS MINIMUM ACCEPTBLE) SAS,R11 1 TIMES 2 GIVES APPX. MIDPOINT. AI,R11 0 TEST... BGZ GOODY OK. CI,R7 ALOCNONX+1 NONE OR LESS -- WS FULL, WHO CALLS BNE ERWSFUL EXECUTION PROCESS CALLED. B 1,R7 NON-EXECUTION PROCESS CALLED. GOODY AW,R11 BLKWANTD = AMT ADDED TO DYNAMIC. STW,R11 FREETOTL PUT THAT AMT IN THE FREE TABLE. STW,R11 FREETBL+1 AW,R11 FREETBL CALC NEW DYNAMIC BOUNDARY, AND MAKE STW,R11 DYNBOUND IT THE CURRENT EXEC. STACK LIMIT STW,R11 STKLIMIT ALSO; THEN 'SEARCH' FOR NEW BLK. FRETSET LI,R5 FREETBL-2 PT AT ENTRY BEFORE FREE TABLE. FREESRCH AI,R5 2 PT AT NEXT FREE TABLE ENTRY. LW,R11 1,R5 GET ITS SIZE... BNEZ SIZETEST OK, TRY IT. STW,R8 LINKWS ZERO MEANS NO ENTRY BIG ENUF. BAL,R8 GARBCOLL DO GARBAGE COLLECTION. LW,R8 LINKWS RESTORE R8. LW,R11 FREETBL+1 GET SIZE COLLECTED, WE KNOW IT'S OK. LI,R5 FREETBL PT AT THAT ENTRY. SIZETEST CW,R11 BLKWANTD IS FREE BLK BIG ENUF... BL FREESRCH NO, KEEP SEARCHING THE FREE TBL. BG SHRINK YES, BIGGER THAN NEEDED. LW,R4 0,R5 EXACT SIZE NEEDED, PURGE THIS FREE SLS,R5 -1 TABLE ENTRY BY MOVING LATER MOVEUP AI,R5 1 ENTRIES UP THE TABLE. LD,R10 0,R5 STD,R10 -2,R5 BNEZ MOVEUP BOTTOM ENTRY IS DOUBLE ZERO. LW,R11 BLKWANTD GET SIZE OF DATA BLOCK. AI,R5 -DA(FREETBL)-1 HAVE WE CLEARED OUT ALL OF FREE TBL BNEZ FINALE NO, JUST ONE ENTRY AMONG OTHERS. LW,R5 DYNBOUND YES, SET 1ST FREE LOCATION TO BE STW,R5 FREETBL THE BOUNDARY FOR DYNAMIC. FINALE STW,R11 0,R4 SET THE DATA BLK HDR'S SIZE FIELD. LCW,R11 BLKWANTD AWM,R11 FREETOTL DECREASE THE TOTAL NO.OF FREE WDS. LI,R11 1 STW,R11 1,R4 SET DATA BLK'S REF-COUNT = 1. B 0,R7 EXIT. SHRINK LW,R4 0,R5 = LOC OF NEW DATA BLOCK SW,R11 BLKWANTD SHRINK THIS FREE TBL ENTRY'S SIZE. STW,R11 1,R5 LW,R11 BLKWANTD GET SIZE OF DATA BLOCK, AND ADJUST AWM,R11 0,R5 LOC OF FREE BLK THAT REMAINS. B FINALE SETRS STW,R4 RESULT RESULT REFS THE NEW DATA BLOCK. LW,R11 RSTYPE GET TYPE SLS,R11 8 MAKE ROOM FOR OR,R11 RSRANK THE RANK AND STH,R11 *RESULT FINISH DATA BLK HEADER. B *R14 EXIT. TEXT AI,R11 3 ROUND NO.OF CHARS UP TO WD MULTIPLE. SLS,R11 -2 NO.OF WDS NEEDED FOR TEXT DATA. B UPRANK LOGL AI,R11 31 ROUND NO.OF BITS UP TO WD MULTIPLE. SLS,R11 -5 NO.OF WDS NEEDED FOR LOGICAL DATA. B UPRANK ALOCTRES EQU TEXT ALLOCATE TEXT RESULT DATA BLK. XSEQ LI,R11 6 AN INDEX SEQ BLK USES 6 WDS, ALMOST. BAL,R7 ALOCBLK STW,R4 RESULT RESULT REFS THE NEW DATA BLOCK. LI,R11 TRNKXSEQ SET TYPE AND RANK (= 1) FOR XSEQ. STH,R11 *RESULT B *R14 EXIT. ************************************************************************ * * * GIVEBACK -- GIVES BACK A PORTION OF A DATA BLOCK. * * REGS: R11 (ENTRY) NO.OF WDS NOT NEEDED. * * R7 LINK, EXIT VIA 0,R7 * * R4 (ENTRY) PTS AT DATA BLOCK HEADER. * * NOTE -- SEE ALSO DREF. R4 & R11 ARE VOLATILE. * * GIVEBACK AND,R11 MINUS2 WON'T GIVE BACK AN ODD NO.OF WDS. BEZ 0,R7 FORGET IT. STW,R11 BLKWANTD SAVE EVEN NO.OF WDS TO GIVE UP. LCW,R11 BLKWANTD = - NO.OF WDS TO GIVE UP. AWM,R11 0,R4 TAKE THAT MANY FROM THE DATA BLK. INT,R11 0,R4 GET SIZE (SHRUNKEN) OF THAT DATA BLK AW,R4 R11 PT AT 1ST WD AFTER THAT DATA BLK. LW,R11 BLKWANTD FAKE DATA BLK (TYPE ZERO) CONTAINING STW,R11 0,R4 'GIVE UP' AMT FOR ITS SIZE FIELD. LI,R11 1 ALSO FAKE A REF-COUNT OF ONE FOR IT. STW,R11 1,R4 B DREF NOW DEREFERENCE THE FAKE DATA BLK. PAGE ************************************************************************ * * CKVDB -- CHECKS STRUCTURE OF A VARIABLE OR TEMP DATA BLK. * CKVDB13 -- ALT.ENTRY; R13= EVEN, NONZERO SIZE * VERIFIES: * SIZE IS EVEN AND NONZERO * RANK IS PERMISSIBLE * LENGTH WORDS LIE INSIDE THE DATA BLK * TYPE IS LOGL,TEXT,INTG,REAL,XSEQ * DATA LIES INSIDE THE DATA BLK * NO LENGTH WORD IS NEGATIVE * REGS: R4 (ENTRY) PTS AT DATA BLK HEADER. * R6 (ENTRY) CONTAINS TYPE. * R7 (LINK) RETURN-0 IF BAD DATA BLK. * RETURN-1 IF OK. * R4,R5,R12,R13 ARE VOLATILE. * CKVDB INT,R13 0,R4 GET DATA BLK SIZE. CI,R13 1 VERIFY EVEN, NONZERO SIZE. BCS,5 0,R7 ERROR EXIT. CKVDB13 AI,R13 -2 DISCOUNT DATA BLK HEADER. LI,R5 1 SET FOR 1 ELEMENT OF DATA. LB,R12 *R4,R5 GET RANK. CI,R12 TOPRANK VERIFY REASONABLE RANK... BG 0,R7 ERROR EXIT. SW,R13 R12 DISCOUNT ANY LENGTH WDS... BLZ 0,R7 TOO SHORT -- ERROR EXIT. CI,R6 TYPEXSEQ VERIFY TYPE... BLE CKVDBV,R6 @ OK, VECTOR ON TYPE. CKVDBV B 0,R7 @ 0 OR HIGH -- ERROR EXIT. B CKVDBL @ LOGL B CKVDBT @ TEXT B CKVDBI @ INTG B CKVDBR @ REAL AI,R12 -1 @ XSEQ, VERIFY RANK =1... BNEZ 0,R7 ERROR EXIT. AI,R13 -3 VERIFY SIZE... BGEZ 1,R7 OK EXIT. B 0,R7 ERROR EXIT. CKVDBL SLS,R13 5 32 ELEMS/WORD. B CKVDBI CKVDBT SLS,R13 2 4 ELEMS/WORD. B CKVDBI CKVDBR SLS,R13 -1 HALF ELEM/WORD. CKVDBI AI,R4 1 PT AT REF-COUNT WD. CKVDBQ AI,R12 -1 DECR RANK REMAINING... BGEZ CKVDBM MULT NEXT LENGTH. CW,R5 R13 DONE, DO # ELEMS FIT... BLE 1,R7 OK EXIT. B 0,R7 ERROR EXIT. CKVDBM AI,R4 1 PT AT NEXT LENGTH WD. MW,R5 0,R4 MULT THAT LENGTH... BOV 0,R7 OFLO -- ERROR EXIT. BGZ CKVDBQ LOOP IF ABOVE ZERO. CKVDBN BLZ 0,R7 NEG LENGTH WD -- ERROR EXIT. AI,R12 -1 DECR RANK REMAINING... BLZ 1,R7 DONE (EMPTY ARRAY) OK EXIT. AI,R4 1 PT AT NEXT LENGTH WD. LW,R5 0,R4 TEST FOR NEG. LENGTH. B CKVDBN PAGE *********************************************************************** * * WSCHEK -- CHECKS WORKSPACE STRUCTURE. THIS ENTRY PROVIDES * A DIAGNOSTIC TOOL; CALLS TO WSCHEK CAN BE PATCHED * IN WHEN IT IS SUSPECTED THAT SOME OPERATION IS DAMAGING * THE WORKSPACE. * WSCKDSPL -- CHECKS A LOADED WORKSPACE STRUCTURE AND * DISPLACES DATA BLOCK POINTERS IF THE WORKSPACE * WAS SAVED WITH A DIFFERENT DYNAMIC ORIGIN * (R2, UPON ENTRY, MUST CONTAIN THE DISPLACEMENT * VALUE OR ZERO -- NOTE R2 IS VOLATILE FOR THIS * ENTRY POINT). * REGS: R14 -- LINK, RETURN-0 IF WS CHECKS OUT * RETURN-1 IF BAD WS. * REGS ARE VOLATILE IF BAD WS * R2 IS VOLATILE FOR THE WSCKDSPL ENTRY; * OTHERWISE, REGS ARE PRESERVED. * CHECKS PERFORMED: * - EACH EXECUTION-STACK ENTRY HAS A VALID CATEGORY * - NO DATA BLOCK OVERLAPS THE DYNAMIC BOUNDARY. * - EACH DATA BLK HAS A POSITIVE REF COUNT. U06-0004 * - EACH DATA BLK SIZE IS EVEN & NONZERO. * - EACH DATA BLK TYPE FIELD IS VALID: * - (LOGL,TEXT,INTG,REAL,XSEQ) FURTHER TESTS ARE * MADE BY THE 'CKVDB' ROUTINE. * - (LIST) TRACKING WORD MUST BE ZERO. * - (CODESTRING) OFFSET ABOVE ZERO AND RTMOST * BYTE WITHIN 7 BYTES OF THE NEXT BLOCK. * - (INTRINSIC FUNCTION) SIZE = 2. * - (GROUP) LAST HALFWD WITHIN 3 HALFWDS OF THE * NEXT BLOCK. * - TOTAL REF-COUNT ACCUMULATION BALANCES THE TOTAL * NO.OF DATA BLOCK POINTERS. * THE DATA BLK POINTERS OF INTEREST ARE THOSE OCCURRING IN: * THE STRAY BLOCK 'STRAYS', * THE EXEC. STACK (V,X,Q,D,F CATEGORY ENTRIES), * THE SYMBOL TABLE (REF-INDICATORS & LONG-NAME PTRS), * THE DATA BLOCKS THEMSELVES (LISTS & FUNCTION DESCR'S). * WSCHEK STW,R2 GARBSAVE+2 SAVE R2 FOR THIS ENTRY PT. LI,R2 0 SET DISPLACEMENT VALUE = 0. WSCKDSPL LCI 11 SAVE R3 THRU R13. STM,R3 GARBSAVE+3 LI,R3 0 CLEAR REF-ACCUMULATION. LI,R7 -1 WFREESET AI,R7 1 LD,R4 FREETBL,R7 FREE FRAG. (LOC & SIZE)... AI,R5 0 BEZ WSTRAYS NO MORE IN USE. STW,R3 1,R4 FAKE A DATA BLK OF THAT SIZE STW,R5 0,R4 MAKE IT A FREE BLK, B WFREESET REF-CNT = 0 & TYPE = 0. WSTRAYS LI,R13 STRAYBLK = # STRAY DATA BLK PTRS. LI,R4 STRAYS PT AT 1ST STRAY D. B. PTR. BAL,R7 AQMDP ACCUM REF & DISPLACE. AI,R4 1 PT AT NEXT. BDR,R13 AQMDP LOOP THRU STRAYS. LW,R4 TOPOSTAK PT AT TOP OF EXEC. STACK. B WSTAK WDROPOP AI,R4 2 SKIP 2-WD O-CATEGORY. B WSTAK W1 BAL,R7 AQMDP ACCUM REF & DISPLACE. WPOP AI,R4 1 PT AT NEXT EXEC.STACK WD. WSTAK LB,R6 *R4 = STACK ENTRY CATEGORY... AI,R6 -CATLC BLEZ WSCAT+CATLC,R6 VECTOR IF LEGAL CATEGORY. BAL,R15 WSERR OOPS -- BAD CATEGORY. WSCAT B W1 @ V B WPOP @ A' B WDROPOP @ O B W1 @ X B WPOP @ B B WPOP @ P B WPOP @ S AI,R4 1 @ Q -- MOVE TO CURRPTR WD. B W1 @ D B WPOP @ A B WFCAT @ F * B WLC @ LINE-CHAIN WLC BAL,R7 AQMDP @ ACCUM REF & DISPLACE. AI,R4 3 PT AT NEXT ENTRY IN EXEC.STACK. B WSTAK WFCAT LI,R5 X'7FFF' EXTRACT ITS 'NEXT' FIELD... AND,R5 0,R4 BEZ WSYM (FINAL) HIT SYMBOL TABLE. AI,R4 1 (FUNC.) PT AT FDEFPTR WD. BAL,R7 AQMDP ACCUM REF & DISPLACE. AI,R4 1 PT AT CALLPTR WD. BAL,R7 AQMDP ACCUM REF & DISPLACE. AI,R4 3 PT 2 WDS PAST # SHAD. PAIRS. LW,R13 -2,R4 HOW MANY... BEZ WFBU NONE. BAL,R7 AQMDP ACCUM REF & DISPLACE. AI,R4 2 PT 2 WDS FURTHER. BDR,R13 AQMDP LOOP TILL BEYOND. WFBU BDR,R4 WSTAK BACK UP TO ENTRY PAST F-ENTRY & * GO CHECK ITS CATEGORY. WSYM LW,R13 SYMTSIZE = # ENTRIES FOR SYM TBL. LI,R12 NAMEWDSZ = MAX # WDS TO HOLD NAME. LW,R4 SYMT PT AT 1ST REF-INDIC WD. WSYME LI,R7 WSYMN EXIT AQMDP AT WSYMN. AQMDP LI,R5 X'1FFFF' AND,R5 0,R4 TEST FOR DATA BLK PTR... BEZ 0,R7 NIL -- EXIT. AWM,R2 0,R4 YES, DISPLACE IT PERHAPS. AI,R3 1 ACCUM 1 MORE REFERENCE. B 0,R7 EXIT. WSYMN AI,R4 1 PT AT NEXT NAME-INDIC WD CB,R12 *R4 & CK FOR SHORT NAME... BL WSYMS YES. BAL,R7 AQMDP NO, LONG OR NIL. WSYMS AI,R4 1 PT AT NEXT REF-INDIC WD & BDR,R13 WSYME LOOP TILL DONE. STW,R4 GCTEMP DONE, R4 PTS AT 1ST DATA B WDBQ BLK, PROBABLY. WDBV BAL,R7 CKVDB13 @ CK VAR OR TEMP DATA BLK... BAL,R15 WSERR @ OOPS -- BAD. WNBLK LW,R4 GCTEMP @ OK, PT AT NEXT BLK UNLESS WDBQ CW,R4 DYNBOUND REACHED DYNAMIC BOUNDARY... BL WDB NOT YET. BE WEND YES, GOOD SO FAR. BAL,R15 WSERR TOO FAR -- BAD. WDB INT,R13 0,R4 GET SIZE OF THIS DATA BLK. AWM,R13 GCTEMP (UPDATE PTR TO NEXT BLK). CI,R13 1 SIZE EVEN & NONZERO... BCR,5 WDBREF OK. BAL,R15 WSERR OOPS -- BAD. WDBREF SW,R3 1,R4 ACCT FOR BLK'S REF-COUNT. LB,R6 *R4 GET DATA BLK'S TYPE... BEZ WNBLK FREE BLOCK. LW,R8 1,R4 (CK REF-COUNT) U06-0006 BGZ WDBREFOK (OK) U06-0007 BAL,R15 WSERR (BAD) U06-0008 WDBREFOK CI,R6 TYPELIST U06-0009 BL WDBV VARIABLE OR TEMP. AI,R6 -TYPLONGN BLEZ WDBT-TYPELIST+TYPLONGN,R6 BAL,R15 WSERR INVALID TYPE -- BAD. WDBT B WLIST @ LIST. B WCS @ CODESTRING. B WFUND @ FUNCTION DESCRIPTOR. B WFUND @ '' '' B WFUND @ '' '' B WFUND @ '' '' B WFUND @ '' '' B WFUND @ '' '' B WIF @ INTRINSIC FUNCTION. B WIF @ '' '' B WIF @ '' '' B WGRP @ GROUP. B WLN @ LONG NAME. WLN EQU WNBLK WIF AI,R13 -2 IS SIZE = 2... BEZ WNBLK YES. BAL,R15 WSERR NO -- BAD. WGRP AI,R4 2 PT AT WD CONTAINING LH,R8 *R4 # NAMES IN THIS GROUP. SLS,R8 -1 GO WITH # OF FURTHER WDS B WOFFCK IN GROUP DATA BLK. WCS AI,R4 2 PT AT WD CONTAINING OFFSET. LH,R8 *R4 VERIFY ABOVE ZERO... BGZ WCSO OK # BYTES OF CODESTRING. BAL,R15 WSERR BAD. WCSO SLS,R8 -2 # MORE WDS IN CS DATA BLK. WOFFCK AW,R4 R8 PT AT LAST WD IN USE. OR,R4 BITPOS-31 (OR ODD GARBAGE WD). AI,R4 1 PT AT NEXT WD; IT SHOULD BE CW,R4 GCTEMP NEXT DATA BLK LOC. BE WDBQ OK, IT IS. BAL,R15 WSERR BAD. WLIST AI,R4 3 PT PAST LENGTH WD. LW,R13 -1,R4 GET LENGTH OF LIST... BEZ WLISTZ 0, CK TRACKING WD ONLY BAL,R7 AQMDP ACCUM REF & DISPLACE. AI,R4 1 PT AT NEXT WD. BDR,R13 AQMDP LOOP TILL TRACKING WD HIT. WLISTZ LW,R13 0,R4 TRACKING WD = 0... BEZ WNBLK YES -- OK. BAL,R15 WSERR NO -- BAD. WFUND AI,R4 XSIZOFF PT AT XSIZE WD. LI,R13 X'E0000' CW,R13 0,R4 DOES IT PT AT ERR-CTRL TBL... BAZ WFUNDNFL NO. BAL,R7 AQMDP YES, ACCUM REF & DISPLACE. WFUNDNFL LW,R13 NFLOFF-XSIZOFF,R4 GET # FUNCTION LINE PTRS... BEZ WNBLK NONE. AI,R4 -XSIZOFF+NFLOFF+1 PT AT 1ST LINE PTR. BAL,R7 AQMDP ACCUM REF & DISPLACE. AI,R4 1 PT AT NEXT WD. BDR,R13 AQMDP LOOP TILL LOCAL-LABEL WD. LI,R13 X'FFFF' AND,R13 0,R4 GET # LABEL ENTRIES... BEZ WNBLK NONE. AI,R4 2 PT AT ENTRY'S DB PTR WD. BAL,R7 AQMDP ACCUM REF & DISPLACE. AI,R4 2 PT AT NEXT, IF ANY. BDR,R13 AQMDP LOOP TILL DONE B WNBLK WEND AI,R3 0 CK REF BALANCE... BEZ WSOK OK. LI,R15 WSERR BAD (SET R15). WSERR AI,R14 1 SET FOR RETURN-1 (ERROR). B *R14 WSOK LCI 12 LM,R2 GARBSAVE+2 RESTORE REGS SAVED ON ENTRY. B *R14 RETURN. PAGE ************************************************************************ * * * CTEST -- WHEN MORE COMMON IS NEEDED, CTEST IS ENTERED. IT DECIDES * * WHETHER TO GET A NEW PAGE OF COMMON OR TO OVERLAP INTO THE * * CURRENT DYNAMIC AREA. * * REGS: R8 -- LINK (VOLATILE) EXIT VIA *LINKWS. * * RETURN+0 IF WS FULL. * * RETURN+1 IF ENUF COMMON OBTAINED. * * R1 -- (EXIT) PTS AT LOC REQUESTED BY LOCNEED IF OK. * * * CTEST AI,R8 1 SET FOR NORMAL RETURN. STW,R8 LINKWS SAVE THAT LINKAGE. STW,R1 TOPOSTAK SAVE PTR TO CURRENT TOP OF STACK. CTEST1 LW,R8 CORLEFT ARE PAGES AVAILABLE... BNEZ GET1C YES -- GET 1 MORE. BAL,R8 GARBCOLL NO, DO GARBAGE COLLECTION. LW,R8 LOCNEED CALC. SPACE BETWEEN LOC NEEDED & SW,R8 FREETBL LAST DYNAMIC WD IN USE. SAS,R8 -2 DIVIDE BY 4 (4 IS MINIMUM ACCEPTBLE) SAS,R8 1 TIMES 2 TO GET APPX. MIDPOINT AI,R8 0 TEST... BGZ CTESTOK ENUF. MTW,-1 LINKWS NOT ENUF, BACK UP FOR THE B *LINKWS WS FULL EXIT. CTESTOK STW,R8 FREETOTL PUT ABOUT HALF OF LEFT-OVER SPACE STW,R8 FREETBL+1 IN FREE TABLE, SETTING THE AW,R8 FREETBL DYNAMIC BOUNDARY & STACK LIMIT STW,R8 DYNBOUND EQUAL (AT MID POINT). GOTC STW,R8 STKLIMIT SET NEW STACK LIMIT. LW,R1 LOCNEED SET STACK PTR TO LOC NEEDED. B *LINKWS EXIT GET1C STW,R14 GARBSAVE+14 SAVE R14. BAL,R14 GETCOM GET ANOTHER COMMON PAGE. LW,R14 GARBSAVE+14 RESTORE R14. LW,R1 LOCNEED SET STACK PTR TO LOC NEEDED. CW,R1 STKLIMIT MAKE SURE WE HAVE ENUF STACK... BG *LINKWS YES, EXIT LW,R1 TOPOSTAK NO, RESET R1 IN CASE WS FULL. B CTEST1 TRY FOR ANOTHER PAGE. PAGE ************************************************************************ * * * SICLR -- CLEARS ENTRIES OFF THE STATE INDICATOR UNTIL REACHING THE * * ENTRY THAT 'GOSTATE' POINTS TO. * * SICLR% -- ALTERNATE ENTRY PT, R1 PTS AT TOP OF STACK. * * REGS: R14 LINK, EXIT VIA *R14. * * R1 (EXIT) PTS AT NEW TOP OF STACK AFTER CLEARANCE. * * R2 (EXIT) CATEGORY AT TOP OF STACK AFTER CLEARANCE. * * VOLATILE: R4,R5,R7,R13 SEE ALSO 'DREF'. * * * SICLR LW,R1 TOPOSTAK PT AT TOP OF STACK. B SICLR% SICLROP AI,R1 2 DROP BOTH WDS OF O-CATEGORY. B SICLR% SICLRQ AI,R1 1 DROP 1ST WD OF Q-CATEGORY. MTW,-2 0,R1 MAKE CODESTRING PTR PT AT DB HDR. SICLR1 LI,R4 0 XW,R4 0,R1 CLEAR & DEREFERENCE IF DB PTR. BAL,R7 MAYDREF SICLRG AI,R1 1 DROP A WD. SICLR% LB,R2 *R1 GET CATEGORY NOW AT TOP. CW,R1 GOSTATE HAVE WE REACHED THE GO-STATE YET... BL SICLRT,R2 NO, VECTOR ON THE CATEGORY. STW,R1 TOPOSTAK YES, UPDATE TOP OF STACK PTR. STW,R1 STATEPTR UPDATE STATE PTR EQUIVALENTALLY. B *R14 EXIT. SICLRT B SICLR1 @ V B SICLRG @ A-PRIME B SICLROP @ O B SICLR1 @ X B SICLRG @ B B SICLRG @ P B SICLRG @ S B SICLRQ @ Q B SICLR1 @ D B SICLRG @ A * B SICLRF @ F * @ (LINE-CHAIN NOT ALLOWED) SICLRF LI,R4 0 @ XW,R4 1,R1 CLEAR & DEREF FDEFPTR WD UNLESS SI- BAL,R7 MAYDREF DAMAGED ENTRY. LI,R4 0 XW,R4 2,R1 CLEAR & DEREF CALLPTR WD AFTER AI,R4 -2 CODESTRING PTR ADJUSTED TO DB HDR. BAL,R7 DREF AI,R1 4 PT AT WD AFTER NO.OF SHADOW PAIRS. LW,R13 -1,R1 HOW MANY... BEZ SICLR% NONE, RESUME CLEARANCE. LI,R7 SICLRFX SET RETURN FROM MAYDREF CALL, BELOW. SICLRFS LW,R5 0,R1 GET NAME PTR OF SHADOW PAIR ENTRY. LI,R4 0 CLEAR & GET SHADOWED REFERENT. XW,R4 1,R1 XW,R4 *SYMT,R5 UNSHADOW. AI,R1 2 PT PAST THIS SHADOW PAIR. B MAYDREF DEREF LOCAL DATA BLK, IF ANY. SICLRFX BDR,R13 SICLRFS LOOP TILL DONE WITH SHADOW PAIRS. B SICLR% PAGE * * IN2CODE--BYTE TABLE. FOR EACH POSSIBLE INTERNAL CHARACTER, THERE IS A * CORRESPONDING BYTE. IN MOST CASES THIS IS THE CODESTRING VALUE * FOR THAT CHARACTER OR (FOR NAME CHARS) THE HASH CODE. BLANK, * END-OF-INPUT, AND QUOTE USE SPECIAL VALUES; BAD (UNEXPECTED) * CHARS. USE THE SPECIAL CODE X'47'. * * * * CODE * HEX * TRANSLATION CORRESPONDENCES: * BYTES *RANGE* (BYTE 0) (BYTE 1) (BYTE 2) (BYTE 3) * -------- -- -- -------- -------- -------- -------- IN2CODE DATA X'47474747' @00-03 BAD BAD BAD BAD DATA X'47474747' @04-07 BAD BAD BAD BAD DATA X'47474747' @08-0B BAD BAD BAD BAD DATA X'47474747' @0C-0F BAD BAD BAD BAD DATA X'47474747' @10-13 BAD BAD BAD BAD DATA X'47324747' @14-17 BAD END-INPT BAD BAD DATA X'47474747' @18-1B BAD BAD BAD BAD DATA X'47474747' @1C-1F BAD BAD BAD BAD DATA X'47474747' @20-23 BAD BAD BAD BAD DATA X'47474747' @24-27 BAD BAD BAD BAD DATA X'47474747' @28-2B BAD BAD BAD BAD DATA X'47474747' @2C-2F BAD BAD BAD BAD DATA X'47474747' @30-33 BAD BAD BAD BAD DATA X'47474747' @34-37 BAD BAD BAD BAD DATA X'47474747' @38-3B BAD BAD BAD BAD DATA X'47474747' @3C-3F BAD BAD BAD BAD DATA X'3365727E' @40-43 BLANK %FCT %ECD % DATA X'63784B9D' @44-47 %MIN %E %GU %UDL DATA X'D055832D' @48-4B %DLT %I %CPL .(DOT) DATA X'66295B64' @4C-4F %LT ( + %ABS DATA X'854A2423' @50-53 %CAP %IB %QQ %Q DATA X'52736160' @54-57 %TBR %DCD %O %LOG DATA X'59142E86' @58-5B %REV %COM %SC %CUP DATA X'5F2A264D' @5C-5F * ) ; %NOT DATA X'5C546253' @60-63 %-(SUBR) / %MAX %RD1 DATA X'75478084' @64-67 %DRP BAD %W %CPR DATA X'58477457' @68-6B %RV1 BAD %TAK , DATA X'567D6851' @6C-6F %R %U %GT %RND DATA X'6C7B7C4C' @70-73 & %DRS -(NEG) %GD DATA X'6782696E' @74-77 %LE %LOK %GE %NND DATA X'6F6D876A' @78-7B %NOR %OR : %NE DATA X'7F346B81' @7C-7F @ '(QUOTE) = %DEL DATA X'4799BBCE' @80-83 BAD %UA %UB %UC DATA X'F0BFA1FC' @84-87 %UD %UE %UF %UG DATA X'A9F44747' @88-8B %UH %UI BAD BAD DATA X'47474747' @8C-8F BAD BAD BAD BAD DATA X'47E6D2E2' @90-93 BAD %UJ %UK %UL DATA X'C5D6B58F' @94-97 %UM %UN %UO %UP DATA X'B1954747' @98-9B %UQ %UR BAD BAD DATA X'47474747' @9C-9F BAD BAD BAD BAD DATA X'4747C393' @A0-A3 BAD BAD %US %UT DATA X'A5F8EADA' @A4-A7 %UU %UV %UW %UX DATA X'DECA4747' @A8-AB %UY %UZ BAD BAD DATA X'47474747' @AC-AF BAD BAD BAD BAD DATA X'76775A47' @B0-B3 %XP1 %XPD %TPS BAD DATA X'2728191A' @B4-B7 %( %) %Q0 %Q1 U06-0011 DATA X'1B1C1D1E' @B8-BB %Q2 %Q3 %Q4 %Q5 DATA X'1F202122' @BC-BF %Q6 %Q7 %Q8 %Q9 DATA X'47AB9BBD' @C0-C3 BAD A B C DATA X'91C7A3A7' @C4-C7 D E F G DATA X'B3EE4747' @C8-CB H I BAD BAD DATA X'47474747' @CC-CF BAD BAD BAD BAD DATA X'47D8DC9F' @D0-D3 BAD J K L DATA X'E4CC97B9' @D4-D7 M N O P DATA X'F6AF4747' @D8-DB Q R BAD BAD DATA X'47474747' @DC-DF BAD BAD BAD BAD DATA X'47478DFA' @E0-E3 BAD BAD S T DATA X'F2C1FEE8' @E4-E7 U V W X DATA X'D4E04747' @E8-EB Y Z BAD BAD DATA X'47474747' @EC-EF BAD BAD BAD BAD DATA X'00010203' @F0-F3 0 1 2 3 DATA X'04050607' @F4-F7 4 5 6 7 DATA X'08095D5E' @F8-FB 8 9 # % DATA X'2B2C5047' @FC-FF %GO %IS %MDV BAD PAGE ************************************************************************ * * * ACQNXCC -- ACQUIRES THE NEXT INTERNAL-FORM CHAR AND ITS CODE (E.G. * * CODESTRING VALUE, KEY INDICATOR, OR HASH VALUE). * * ACQCC -- ENTRY POINT FOR CURRENT CHAR, RATHER THAN NEXT ONE. * * ACQCODE -- ENTRY POINT TO JUST SET THE CODE * * * * REGS: R1 (ENTRY) PTS AT LATEST, OR CURRENT, CHAR IN THE * * INPUT STRING. (EXIT) PTS AT CHAR ACQUIRED. * * R2 (EXIT) THE CHAR, ITSELF. * * R3 (EXIT) THE CODE FOR THAT CHAR. * * R4 LINK, EXIT VIA 0,R4 * * * ACQNXCC AI,R1 1 PT AT NEXT CHAR. ACQCC LB,R2 0,R1 GET CHAR. ACQCODE LB,R3 IN2CODE,R2 GET ITS CODE. B 0,R4 EXIT. PAGE ************************************************************************ * * * ACQNXNB -- ACQUIRES THE NEXT NON-BLANK INTERNAL-FORM CHAR AND ITS * * CODE (E.G. CODESTRING VALUE, KEY INDICATOR, OR HASH VALUE). * * ACQNB -- ENTRY POINT THAT STARTS WITH CURRENT CHAR, RATHER THAN NEXT.* * REGS: R1 (ENTRY) PTS AT LATEST, OR CURRENT, CHAR IN THE * * INPUT STRING. (EXIT) PTS AT NON-BLANK CHAR ACQ'D. * * R2 (EXIT) THE NON-BLANK CHAR, ITSELF. * * R3 (EXIT) THE CODE FOR THAT CHAR. * * R4 LINK, EXIT VIA 0,R4 * * * ACQNXNB AI,R1 1 PT AT NEXT CHAR. ACQNB LB,R2 0,R1 GET CHAR. AI,R2 -' ' CK FOR BLANK. BEZ ACQNXNB YES, TRY NEXT ONE. AI,R2 ' ' NO, RESTORE THAT CHAR. LB,R3 IN2CODE,R2 GET ITS CODE. B 0,R4 EXIT. PAGE ************************************************************************ * * * ACQNAME -- ACQUIRES A NAME (GIVEN THE NAME-START UPON ENTRY), HUNTS * * FOR THAT NAME IN THE SYMBOL TABLE, IF NEW NAME ENTERS THAT * * NAME, AND EXITS WITH THE PTR TO REFERENT-INDICATOR AND TYPE * * OF NAME ACQUIRED (STOPNAME, TRACENAME, OR ORDINARY NAME). * * REGS: R1 (ENTRY) PTS AT NAME-START CHAR IN INPUT STRING. * * (EXIT) PTS AT (NON-BLANK) CHAR AFTER NAME. * * R2 (ENTRY) CONTAINS NAME-START CHAR. * * (EXIT) CONTAINS CHAR AFTER NAME. * * R3 (ENTRY) CODE FOR NAME-START CHAR, ITS HASH VALUE. * * (EXIT) CODE FOR CHAR AFTER NAME. * * R4, R5, R7, R10, R11, R14 ARE VOLATILE. * * R6 (EXIT) PTR TO REFERENT INDICATOR WD FOR NAME * * R12 LINK -- 3 RETURNS: * * RETURN-0 -- SYMBOL TABLE FULL. * * (ALSO USED FOR 'NAME- * * NOT-FOUND' RETURN WHEN* * ACQNAME IS CALLED BY * * FINDNAME, SEE BELOW). * * RETURN-1 -- WS FULL ON LONG NAME. * * RETURN-2 -- NORMAL. * * R13 (EXIT) TYPE OF NAME: * * 21 = STOPNAME (S-DELTA-NAME) * * 22 = TRACENAME (T-DELTA-NAME) * * 23 = ORDINARY NAME * * * ACQNAME AI,R1 1 PT AT CHAR AFTER THE NAME-START LI,R13 DELTA CB,R13 0,R1 IS IT A DELTA... BNE NORMAL NO, ORDINARY NAME CLM,R2 SANDT YES, DID NAME START ON S OR T... BCS,9 NORMAL NO, ORDINARY NAME LW,R13 R2 YES, COMPUTE STOPNAME OR THE AI,R13 STOPNMCD-'S' TRACENAME CODESTRING DESIGNATOR. BAL,R4 ACQNXCC ACQ NEXT CHAR AND CODE CI,R3 LASTCSV IS IT A NAME-START CHAR... BG STPORTRC YES, BEGINS NAME TO STOP OR TRACE. AI,R1 -3 NO, ASSUME ORDINARY NAME BAL,R4 ACQNXCC RE-ACQ THE S OR T. AI,R1 1 PRETEND TO PT AT THE DELTA. NORMAL AI,R1 -1 FORGET ABOUT THE CHAR AFTER 1ST ONE. LI,R13 NAMECODE ORDINARY NAME CODESTR. DESIGNATOR. STPORTRC LI,R5 -1 PRE-SET NAME BUFFER BYTE OFFSETTER. LI,R14 NAMLIMIT = NO.OF CHARS ACCEPTED PER NAME LI,R6 0 CLEAR FOR DIVISION OF HASH TOTAL. LI,R7 0 CLEAR HASH ACCUMULATOR. STW,R7 HASHAQM LI,R4 ENDTESTR SO 'BDR,R14 ACQNXCC' WILL CAUSE A * RETURN TO 'ENDTESTR' UNLESS NAME * GETS TOO LONG. NAMECHAR AWM,R3 HASHAQM ADD LATEST HASH VALUE. AI,R5 1 NEXT CHAR OFFSET INTO NAME BUFFER. STB,R2 NAMEBUF,R5 PUT CHAR IN NAME BUFFER. BDR,R14 ACQNXCC ACQ NEXT CHAR IF NAME ISN'T TOO LONG * (RETURN IS TO 'ENDTESTR'). BAL,R4 ACQNXCC TOO LONG, SKIP TILL NON-NAME-CHAR. CLM,R3 NONAME SHOWS UP. BCS,9 ACQNXCC NOT YET, TRY AGAIN B NAMEDONE BINGO, FINALLY. BLANKER STB,R14 NAMEBUF,R5 FILL IN A BLANK. B FILLER ENDTESTR CLM,R3 NONAME ANOTHER NAME-CHAR... BCS,9 NAMECHAR YES, TRY AGAIN NAMEDONE LW,R7 HASHAQM NO, NAME IS DONE. SLS,R7 1 GET PARTIAL HASH VALUE & CALC TOTAL LB,R4 NAMEBUF,R5 HASH VALUE = 2 * PARTIAL HASH VALUE AW,R7 R4 + LAST CHAR (EBCDIC). BAL,R4 ACQNB ACQ THE NON-BLANK AFTER THE NAME. FINNAME LI,R14 ' ' PREPARE FOR BLANK FILLING. FILLER AI,R5 1 CK FOR WD BOUNDARY CI,R5 3 BANZ BLANKER NO, APPEND A BLANK IN NAME BUFFER. SLS,R5 -2 YES, GET NO.OF WDS FOR NAME. DW,R6 SYMTSIZE REMAINDER (R6) WILL BE TENTATIVE SLS,R6 1 ENTRY INTO SYM TBL. CONVERT TO AI,R6 1 POINTER TO NAME INDICATOR WD. LW,R14 SYMTSIZE FOR COUNTDOWN IF HASHING CRASHING. CI,R5 1 IS THIS A LONG OR SHORT NAME... BE SHORT SHORT NAME * LONG NAME SCS,R5 -8 PUT NO.OF NAME WDS IN BYTE 0, AND STW,R5 NAMEWDS SAVE IT. LONG LW,R5 *SYMT,R6 GET A NAME INDICATOR WD. BEZ NEWLNAME NEW LONG NAME. LB,R4 R5 LOOK FOR MATCHING WORD COUNT. CB,R4 NAMEWDS BNE RELONG NO, TRY ANOTHER HASH LOC. AI,R5 -1 YES, PT AT REF WD IN OLD DATA BLK. AI,R6 -1 LW,R7 *SYMT,R6 (TRY ANOTHER HASH LOC IF THIS AI,R6 1 IS AN ALIEN LONG NAME PTR, CI,R7 X'40000' I.E. DURING FILE-TYPE COPY CMD) BANZ RELONG LGNAMCK LW,R7 NAMEBUF-1,R4 TEST LONG NAME FOR MATCHING WORDS, CW,R7 *R5,R4 GOING FROM LAST WD TO FIRST WD... BNE RELONG NO, TRY ANOTHER HASH LOC. BDR,R4 LGNAMCK YES, LOOP TILL FIRST WD. B FOUND OK, FOUND MATCHING NAME. RELONG LI,R7 LONG SET TO RETURN TO 'LONG' NEWSTLOC AI,R6 2*HASHINC INCR TO ANOTHER NAME INDICATOR WD. CW,R6 NSYMTWDS ARE WE STILL IN THE SYM TBL... BL INSIDE YES. SW,R6 NSYMTWDS NO, CYCLE BACK IN. INSIDE BDR,R14 0,R7 RETURN UNLESS WE'VE HIT ALL ENTRIES. B *R12 OH-OH, TAKE SYM TBL FULL RETURN. WSFULLLN AI,R12 1 TAKE WS FULL RETURN, LONG NAME DATA B *R12 BLK WOULDN'T FIT. NEWLNAME CI,R12 FINDNAME+1 WAS ACQNAME CALLED BY FINDNAME... BE *R12 YES -- TAKE 'NAME-NOT-FOUND' EXIT. LB,R11 NAMEWDS NO, GET NO.OF WDS FOR THE NAME. BAL,R14 ALOCNONX ALLOC DATA BLK, HEADER + THOSE WDS. B WSFULLLN OH-OH -- WS FULL. LI,R11 TYPLONGN LONG NAME TYPE OF DATA BLOCK IS STB,R11 *R4 SET IN TYPE-FIELD OF NEW D.B. AI,R4 2 PT AT 1ST NAME WD POS IN NEW D.B. OR,R4 NAMEWDS FILL IN WORD COUNT (= 2 TO 20) AND STW,R4 *SYMT,R6 SET NEW NAME INDICATOR WORD. LB,R7 NAMEWDS PREPARE TO PUT NEW NAME IN THE D.B. AI,R4 -1 PT AT REF WD IN NEW DATA BLOCK. NEWNAMWD LW,R10 NAMEBUF-1,R7 PUT NEW NAME IN LONG NAME DATA BLOCK STW,R10 *R4,R7 FROM LAST NAME WD TO FIRST. BDR,R7 NEWNAMWD B FOUND WE'VE FOUND A NEW NAME. RESHORT BAL,R7 NEWSTLOC TRY ANOTHER HASH LOC. SHORT LW,R7 *SYMT,R6 GET A NAME INDICATOR WD. BEZ NEWSNAME NEW SHORT NAME. CW,R7 NAMEBUF OLD ENTRY, DOES IT MATCH THIS NAME.. BNE RESHORT NO, TRY AGAIN. FOUND AI,R6 -1 PT AT REFERENT-INDICATOR WD (I.E. * LOC RELATIVE TO 'SYMT') AI,R12 2 SET FOR NORMAL RETURN. B *R12 EXIT. NEWSNAME CI,R12 FINDNAME+1 WAS ACQNAME CALLED BY FINDNAME... BE *R12 YES -- TAKE 'NAME-NOT-FOUND' EXIT. LW,R7 NAMEBUF NO, GET NEW SHORT NAME & USE IT AS STW,R7 *SYMT,R6 THE NEW NAME INDICATOR WORD. B FOUND WE'VE FOUND A NEW NAME. PAGE ************************************************************************ * * * FINDNAME -- FINDS A NAME (SEE 'ACQNAME' FOR ENTRY & EXIT SET-UPS). * * R8 IS THE LINK -- IF NAME-NOT-FOUND, RETURN-0 * * -- IF NAME FOUND, RETURN-1 * * * * WHEN 'FINDNAME' IS USED DURING COPYING, R6 PTS AT THE NAME- * * INDICATOR WD OF AN EMPTY SYMBOL TABLE ENTRY IF THE NAME-NOT- * * FOUND RETURN OCCURS. * * (SEE ALSO 'ACQNAME' FOR OTHER REGISTER USAGES). * * * FINDNAME BAL,R12 ACQNAME LOOK FOR THE NAME... B *R8 NOT FOUND (NEW NAME) B *R8 NOT FOUND (IMPOSSIBLE -- WS FULL) AI,R8 1 FOUND. CI,R13 NAMECODE BUT IS IT A NORMAL NAME... BE *R8 YES. BDR,R8 *R8 NO, STOP OR TRACE NAME (ASSUME * NAME NOT FOUND). PAGE ************************************************************************ * * * ACQIT -- ACQUIRES A NAME OR NUMERIC ITEM, IF ANY, ENDING ON THE NEXT * * NON-BLANK AFTER THE ITEM. ITEM PUT IN NAMEBUF, INIT. BLANKED.* * REGS: R14 -- LINK, EXIT IS VIA 'ACQNB' * * R1 -- (ENTRY) PTS TO 1ST CHAR OF ITEM, IF ANY (AT * * THE VERY LEAST, PTS TO A NON-BLANK). * * (EXIT) PTS TO NON-BLANK DELIMITER FOR ITEM. * * R2 -- (EXIT) CONTAINS THAT DELIMITER. * * R3 -- (EXIT) CONTAINS ITS CODE. * * R5 -- (EXIT) CONTAINS NO.OF CHARS MAKING UP THE ITEM.* * R4 AND R8 ARE VOLATILE. * * * ACQIT AI,R1 -1 BACK UP MOMENTARILY. LI,R5 -NAMEWDSZ = NO.OF WDS TO HOLD MAX POSS. NAME. LW,R8 BLANKS BLANK THE ENTIRE NAME BUFFER. ACQITB STW,R8 NAMEBUF+NAMEWDSZ,R5 BIR,R5 ACQITB (R5 ENDS UP AT ZERO). LI,R8 NAMLIMIT = MAX ACCEPTED CHARS PER NAME. BAL,R4 ACQNXCC ACQ NEXT CHAR & ITS CODE. CLM,R3 NONAME TEST FOR NAME-CHAR (INCLUDING DIGIT) BCR,9 ACQITZ NO. STB,R2 NAMEBUF,R5 YES, PUT CHAR IN NAME BUFFER. AI,R5 1 COUNT THAT CHAR (= OFFSET TO NEXT * BYTE IN NAMEBUF AS WELL). BDR,R8 ACQNXCC LOOP TILL MAX CHAR RUNOUT. BAL,R4 ACQNXCC GET NEXT CHAR & CODE. CLM,R3 NONAME CHECK IT... BCS,9 ACQNXCC NAME-CHAR OR DIGIT, SKIP & RETRY. ACQITZ LW,R4 R14 SWITCH LINKAGE TO EXIT AFTER B ACQNB SKIPPING BLANKS. PAGE ************************************************************************ * * * MAYDREF -- EXTRACTS ADDR. FIELD OF R4 AND EITHER EXITS IF ZERO OR * * ELSE ENTERS DREF. * * DREF -- DEREFERENCES THE DATA BLOCK POINTED TO BY R4. IF THE REF- * * COUNT OF THAT BLOCK DECREMENTS TO ZERO, THE BLOCK IS RETURNED * * TO THE FREE TABLE. HOWEVER, FUNCTION DESCRIPTARS AND LISTS * * CANNOT BE FREED UNTIL THE DATA BLOCKS THEY REFERENCE HAVE * * BEEN DEREFERENCED. * * REGS: R7 -- LINK (EXIT VIA 0,R7) * * R4 -- (ENTRY) PTS AT DATA BLOCK TO BE DEREFERENCED. * * R4 IS VOLATILE, ALL OTHER REGS ARE PRESERVED. * * * MAYDREF AND,R4 X1FFFF EXTRACT ADDRESS FIELD. BEZ 0,R7 EXIT IF NIL. DREF MTW,-1 1,R4 DECR DATA BLOCK'S REF-COUNT. BGZ 0,R7 EXIT IF STILL BEING REFERENCED. LCI 6 NO LONGER NEEDED -- SAVE REGS. STM,R5 DREFSAVE LB,R5 *R4 IS THE DATA BLK A LIST OR FUN.DESCR. AI,R5 -TYPELIST BLZ DFREE NO, ORDINARY DATA. BEZ DLIST YES, A LIST. AI,R5 TYPELIST CLM,R5 FUNTYPES BCS,9 DFREE NO, GROUP, CODESTRING, OR INTRINS. STW,R4 DBROOT YES, FUN.DESCR, SAVE PTR TO IT. LI,R9 2 REF IT TWICE -- DBROOT & DBSERIES. STW,R9 1,R4 AI,R4 XSIZOFF PT AT XSIZE WD. LI,R9 X'E0000' CW,R9 0,R4 DOES IT PT AT ERR-CTRL TBL... BAZ DFNFL NO. STW,R4 DBSERIES YES, SAVE PTR TO XSIZE WD. BAL,R10 DSDREF DE-REF THE ERR-CTRL DATA BLK. DFNFL LW,R4 DBROOT PT AT FUN.DESCR. AGAIN. LI,R6 NFLOFF+1 = OFFSET TO 1ST LINE PTR WD. AI,R4 NFLOFF PT AT NO.OF FUNCTION LINES WD. LW,R9 0,R4 BEZ DSOUT NONE, FREE THE FUNC.DESCRIPTOR. DFLPTR AI,R4 1 PT AT FUNC.LINE PTR WD, AND MAKE IT MTW,-2 0,R4 AIM AT ITS DATA BLOCK HDR. BDR,R9 DFLPTR LW,R4 DBROOT RESTORE PTR TO FUNCTION DESCRIPTOR. B DSER HANDLE DATA BLOCK PTR SERIES. DLIST LI,R6 LISTLOFF+1 OFFSET TO 1ST DB PTR IN THE LIST. STW,R4 DBROOT SAVE PTR TO ROOT OF THE LIST. LI,R9 2 WE WILL REF. ROOT TWICE FOR NOW (IN STW,R9 1,R4 'DBROOT' AND 'DBSERIES'). U06-0014 DSER AW,R4 R6 PT AT 1ST DB PTR IN THE SERIES. STW,R4 DBSERIES SAVE IT AS THE SERIES PTR. LW,R9 -1,R4 GET LENGTH OF THE SERIES... BEZ DSOUT 0 -- FREE THE ROOT, IT DOESN'T PT. BAL,R10 DSDREF DE-REF THE 1ST DB THE ROOT PTS AT. MTW,1 DBSERIES INCR SERIES PTR. AI,R9 -1 DECR LENGTH OF SERIES REMAINING... BGZ DSDREF ANOTHER PTR EXISTS, LOOP TO DSDREF LB,R9 *DBROOT END-SERIES -- TEST ROOT'S TYPE... AI,R9 -TYPELIST BEZ DENDLIST A LIST HAS ENDED. LI,R9 X'FFFF' END OF FUN.DESCR LINE PTR SERIES. AND,R9 *DBSERIES DO LABELS FOLLOW... BEZ DSOUT NO -- FREE THE FUN.DESCRIPTOR. DFLBL MTW,2 DBSERIES YES, PT AT DB PTR FOR A LABEL. BAL,R10 DSDREF DE-REF THE LABEL'S SCALAR DATA BLK. AI,R9 -1 WAS THAT THE LAST LABEL... BGZ DFLBL NO, LOOP BACK. DSOUT LI,R4 0 STW,R4 DBSERIES CLEAR 'DBSERIES'. XW,R4 DBROOT CLEAR 'DBROOT' AND PT TO ROOT DB. B DFREE FREE THE ORIG. LIST OR FUN.DESCR. DSDREF LI,R4 0 CLEAR AND EXTRACT THE DB PTR XW,R4 *DBSERIES CONTAINED IN THIS SERIES. AND,R4 X1FFFF BEZ *R10 NIL -- RETURN. MTW,-1 1,R4 DECR ITS REF-COUNT... BGZ *R10 STILL BEING REF'D -- RETURN. LB,R5 *R4 NO LONGER NEEDED, IS THIS ALSO LIST AI,R5 -TYPELIST BNEZ DFREE NO, FREE THAT DATA BLOCK. STW,R4 *DBSERIES YES, RESTORE ITS DB PTR. (WE HAVE MTW,2 1,R4 A TREE). WE WILL REFERENCE THE * NEW LIST TWICE (IN OLD LIST AND * IN 'DBSERIES'). AI,R4 LISTLOFF+1 OFFSET TO 1ST DB PTR IN NEW LIST. LW,R5 -1,R4 GET LENGTH OF NEW LIST. BEZ DEMPTY 0 -- FREE NEW LIST, RESUME OLD. XW,R9 -1,R4 SAVE OLD LENGTH REMAINING, SET NEW. XW,R4 DBSERIES SET NEW SERIES PTR, GET OLD ONE. AW,R5 DBSERIES PT AT NEW LIST'S TRACKING WORD, AND STW,R4 0,R5 SAVE OLD SERIES PTR THERE (OLD PTR * ACTUALLY AIMS AT THE DB PTR TO * THE NEW LIST -- RESTORED ABOVE). B DSDREF START WORKING THE NEW SERIES. DENDLIST LW,R6 *DBSERIES PICK UP LIST'S TRACKING WORD (THE BEZ DSOUT DEFAULT VALUE IS ZERO, SO ZERO * INDICATES THE ROOT LIST; HOWEVER, * A SUB-LIST'S TRACKING WD PTS BACK * TO THE PRIOR NODE WHICH CONTAINS * A DB PTR TO THAT SUB-LIST -- SEE * CODE IN DSDREF). STW,R6 DBSERIES RESTORE PRIOR SERIES PTR (TO THE * LIST JUST ENDED). LW,R6 0,R6 PT AT LIST JUST ENDED. WE SAVED LW,R9 LISTLOFF,R6 PRIOR LENGTH-REMAINING THERE; * RESTORE IT. DEMPTY LI,R4 0 CLEAR AND GET THE DB PTR THAT AIMED XW,R4 *DBSERIES AT THE SUB-LIST TO BE FREED. * (FALL INTO DFREE) NOTE--ITS REF-COUNT IS LEFT = 2. DFREE AND,R4 X1FFFF USE ADDRESS FIELD ONLY. LI,R5 FREETBL-2 SET PTR TO FREE TABLE AND INT,R7 *R4 SIZE OF BLK TO BE FREED. AWM,R7 FREETOTL INCR TOTAL FREE SPACE NOW. DSRCH AI,R5 2 PT AT LOC WD OF NEXT ENTRY. LW,R6 0,R5 GET THAT LOC... BEZ DINSERT 0 MEANS WE'LL INSERT A NEW ENTRY. CW,R6 R4 TEST LOC VERSUS NEW LOC TO FREE... BG DFHI HI MEANS INSERT OR BACK-COALESCE. AW,R6 1,R5 LO -- ADD SIZE OF FREE-TBL ENTRY. CW,R6 R4 DOES IT FORWARD-COALESCE WITH NEW... BNE DSRCH NO, TRY NEXT FREE-TABLE ENTRY. AWM,R7 1,R5 YES, LENGTHEN THAT ENTRY. AW,R6 R7 DOES THAT ENTRY NOW MERGE WITH NEXT CW,R6 2,R5 FREE-TABLE ENTRY (2-WAY COALESCE) BNE DEND NO. LW,R6 3,R5 YES, GET NEXT ENTRY'S SIZE. AWM,R6 1,R5 ADD IT TO CURRENT ENTRY'S SIZE. SLS,R5 -1 PT AT CURRENT DBLWD ENTRY. DSHRINK AI,R5 1 PT AT NEXT DBLWD ENTRY. LD,R6 2,R5 MOVE ITS SUCCESSOR UP ONE ENTRY. STD,R6 0,R5 BNEZ DSHRINK KEEP MOVING UNTIL REACHING 0,0 * (WHICH ENDS THE FREE-TBL). B DEND DCOALBAK AWM,R7 1,R5 LENGTHEN FREE-TABLE ENTRY, AND SET STW,R4 0,R5 ITS LOC TO BE NEW FREE BLK LOC. DEND LW,R4 DBROOT IS THIS A LIST OR FUN.DESCRIPTOR... BNEZ *R10 YES, RESUME SERIES WORK. LCI 6 NO, RESTORE REGS. LM,R5 DREFSAVE B 0,R7 EXIT. DFHI SW,R6 R7 BACK UP CURRENT LOC BY NEW'S SIZE. CW,R6 R4 DO THE FREE BLOCKS JOIN... BE DCOALBAK YES, BACK-COALESCE. DINSERT AI,R5 2 PT AT CURRENT ENTRY'S SUCCESSOR. XW,R4 -2,R5 INSERT LOC & GET CURRENT LOC. XW,R7 -1,R5 INSERT SIZE & GET CURRENT SIZE. BNEZ DINSERT KEEP GOINT TILL ZERO IS GOTTEN. AI,R5 -FREETBL-MAXFRENS-MAXFRENS DID FREE TABLE FILL UP... BLZ DEND NO. LI,R8 DEND YES, RETURN TO 'DEND' AFTER B GARBCOLL GARBAGE COLLECTION. PAGE ************************************************************************ * * * GARBCOLL -- PERFORMS GARBAGE COLLECTION, TERMINATING WITH A SINGLE * * FREE-TABLE ENTRY INDICATING THE TOTAL FREE SPACE BETWEEN THE * * LAST DATA BLOCK AND THE HIGH BOUND FOR DYNAMIC. THIS MAY * * REQUIRE EXTENSIVE DATA BLOCK POINTER ADJUSTMENTS (PERFORMED * * PRIOR TO MOVING THE DATA BLOCKS). * * REGS: R8 -- LINK (EXIT VIA *LINKGC). * * R8 IS VOLATILE, ALL OTHER REGS ARE PRESERVED. * * * GARBCOLL STW,R8 LINKGC SAVE LINK. LCI 0 SAVE ALL REGS. STM,R0 GARBSAVE LW,R8 FREETOTL GET TOTAL AMT OF FREE SPACE. BEZ *LINKGC NONE -- EXIT. MTW,0 FREETBL+2 IS THERE MORE THAN 1 FREE FRAGMENT. BNEZ GFREE YES, START WORKING ON FREE TABLE. AW,R8 FREETBL NO, IS FREE BLK ADJACENT TO THE CW,R8 DYNBOUND HIGH DYNAMIC BOUNDARY... BGE *LINKGC JA -- EXIT VERY GRATIFIED. GFREE LI,R8 0 CLEAR FREE-ACCUMULATION. LD,R2 ZEROZERO R2 = 0 AND R3 = 0 (R3 WILL BE USED * LATER AS A REF-COUNT ACCUMULATOR). LI,R1 -1 PRESET R1, IT IS DUALLY USED -- * OFFSET FOR FREE-TBL MGMT. AND * NO.OF DATA REGIONS THAT NEED TO * BE MOVED. GFSETS AI,R1 1 OFFSET TO A FREE ENTRY. LD,R4 FREETBL,R1 GET LOC & SIZE OF FREE BLOCK. STD,R2 FREETBL,R1 CLEAR THAT FREE TABLE ENTRY. STW,R2 1,R4 SET FREE-BLK'S REF-COUNT TO ZERO; STW,R5 0,R4 MAKE IT A TYPE-ZERO DATA BLK * WHOSE SIZE IS FOR WHOLE FREE * ENTRY. AW,R4 R5 GET BOUNDARY FOR THIS FREE REGION. STW,R4 FBOUNDS,R1 AW,R8 R5 ACCUMULATE FREE FRAGS BELOW THIS STW,R8 FAQMS,R1 BOUNDARY. CW,R8 FREETOTL HAVE WE REACHED TOTAL AMT FREE YET. BL GFSETS NO, WORK ON NEXT FREE-TABLE ENTRY. CW,R4 DYNBOUND YES --IF LAST FREE REGION WAS AT BGE GNRSET END OF DYNAMIC, R1= NO.OF DATA * REGIONS TO BE MOVED. AI,R1 1 OTHERWISE, WE HAVE TO MOVE 1 * MORE (THE REGION AT END). STW,R8 FAQMS,R1 ITS FREE-ACCUMULATION IS SAME & WE * WILL SET THAT BOUND WHEN WE ARE * DAMNED GOOD AND READY (WHICHEVER * HAPPENS FIRST). GNRSET STW,R1 NR2MOVE = NO.OF DATA REGIONS TO BE MOVED. LW,R4 FBOUNDS PT AT 1ST DATA BLOCK THAT WILL MOVE. GREF AW,R3 1,R4 ACCUMULATE NO.OF REFERENCES TO THE * DATA BLKS THAT WILL MOVE (WE WILL * HAVE TO FIND EACH SUCH REF. AND * DISPLACE IT APPROPRIATELY). INT,R13 0,R4 GET THE SIZE OF THAT BLOCK. AW,R4 R13 PT AT ITS SUCCESSOR. CW,R4 DYNBOUND HAVE WE HIT END OF DYNAMIC... BL GREF NO, KEEP GOING. STW,R4 FBOUNDS,R1 READY -- THAT BOUNDS LAST REGION. LI,R9 X'1FFFF' NOTE--USED BY 'DISPLACE' FOR SELECTIVE * LOADS & STORES, LEAVE R9 ALONE. * ----- -- ------ * LI,R11 STRAYBLK = TOTAL # OF STRAY DATA BLK PTRS. LI,R1 STRAYS PT AT 1ST STRAY DATA BLK PTR. BAL,R7 DISPLACE DISPLACE IT IF APPR. AI,R1 1 PT AT NEXT ONE. BDR,R11 DISPLACE LOOP TILL DONE. LW,R1 TOPOSTAK PT AT TOP ENTRY IN EXECUTION STACK. B GSTAK START LOOKING AT THE EXEC. STACK. GDROPOP AI,R1 2 SKIP BOTH WDS OF O-CATEGORY. B GSTAK GDROP AI,R1 1 SKIP & PT AT WD HAVING A DB PTR. G1 BAL,R7 DISPLACE DISPLACE IT IF APPR. GPOP AI,R1 1 PT AT NEXT ENTRY IN EXECUTION STACK. GSTAK LB,R2 *R1 GET CATEGORY OF EXEC. STACK ENTRY. B GSCAT,R2 VECTOR ACCORDING TO CATEGORY. GSCAT B G1 @ V B GPOP @ A-PRIME B GDROPOP @ O B G1 @ X B GPOP @ B B GPOP @ P B GPOP @ S B GDROP @ Q B G1 @ D B GPOP @ A B GFCAT @ F * B GLC @ LINE-CHAIN GLC BAL,R7 DISPLACE @ DISPLACE ITS LINE-PTR IF APPR. AI,R1 3 PT AT NEXT ENTRY IN EXEC. STACK. B GSTAK GFCAT LI,R4 X'7FFF' EXTR. ITS 'NEXT' FIELD. ZERO TELLS AND,R4 0,R1 US WE'VE HIT THE 'FINAL' ENTRY. BEZ GSYM OK, NOW CHECK THE SYMBOL TABLE. AI,R1 1 RATS, PT AT 'FDEFPTR' ENTRY. BAL,R7 DISPLACE DISPLACE IT IF APPR. AI,R1 1 PT AT 'CALLPTR' ENTRY. BAL,R7 DISPLACE AI,R1 3 PT AT 2ND WD PAST '# OF SHADOW PAIRS LW,R4 -2,R1 FOR THIS FUNCTION STATE', & GET #. BEZ GFBU NONE -- BACK UP 1 WD & CK IT. BAL,R7 DISPLACE DISPLACE SHADOWED REFERENT-INDICATOR * IF APPROPRIATE. AI,R1 2 PT 2 ENTRIES FURTHER INTO STACK. BDR,R4 DISPLACE LOOP IF ITS A SHADOWED REF-INDIC. GFBU BDR,R1 GSTAK PT AT WD AFTER FUNCTION-STATE BLOCK * AND CHECK ITS CATEGORY. GSYM LW,R11 SYMTSIZE = NO.OF DBLWDS IN SYMBOL TABLE. LI,R4 NAMEWDSZ = MAX # WDS TO HOLD A NAME (A 77- * CHAR NAME OCCUPIES 20 WORDS). LW,R1 SYMT PT AT 1ST WD OF SYMBOL TABLE (EVEN). LW,R12 BITPOS-12 (R-BIT FOR COPY REFERENT PTRS) LI,R13 X'40000' (W-BIT FOR COPY NAME-INDICATORS) GSYMW LW,R6 1,R1 LOOK AT THIS ENTRY'S NAME-INDIC WD. BEZ GSYMR UNUSED NAME ENTRY. U06-0016 CB,R4 R6 USED. LONG OR SHORT NAME... BL GSYMR SHORT. CW,R13 0,R1 LONG, IS W-BIT SET... BANZ GSYMR YES, DON'T DISPLACE COPY PTR. AI,R1 1 NO, PT AT NAME-INDIC WD. BAL,R7 DISPLACE DISPLACE LONG-NAME PTR, IF APPR. AI,R1 -1 PT AT REF-INDIC WD AGAIN. GSYMR CW,R12 0,R1 IS R-BIT SET... BANZ GSYMU YES, DON'T DISPLACE COPY PTR. BAL,R7 DISPLACE NO, DISPLACE REF-PTR, IF APPR. GSYMU AI,R1 2 PT AT NEXT ENTRY. BDR,R11 GSYMW LOOP TILL PAST SYMBOL TABLE. B GDBT NOTE--END OF SYM TBL, R1 PTS AT 1ST DATA * (OR FREE) BLOCK AUTOMATICALLY. GDBLIST LW,R11 LISTLOFF,R1 = NO.OF DB PTRS IN LIST, AI,R11 1 + 1 MORE FOR ITS TRACKING WORD. STW,R1 GCTEMP SAVE PTR TO THIS LIST DATA BLK. AI,R1 LISTLOFF+1 PT AT 1ST PTR WD IN THE LIST. BAL,R7 DISPLACE DISPLACE IT IF APPR. AI,R1 1 PT AT NEXT WD. BDR,R11 DISPLACE LOOP TILL PAST THE TRACKING WORD. GDBRR1 LW,R1 GCTEMP RESTORE DATA BLK PTR. GNBLK INT,R13 0,R1 GET SIZE OF THIS BLOCK. AW,R1 R13 PT AT NEXT BLOCK. CW,R1 DYNBOUND HAVE WE EXCEEDED THE DATA BLK AREA. BL GDBT NO. BAL,R15 SYSTERR YES -- SYSTEM ERROR. GDBT LB,R2 *R1 GET TYPE OF DATA (OR FREE) BLOCK. B GDBQ,R2 VECTOR ACCORDING TO TYPE. GDBQ B GNBLK 0 @ FREE B GNBLK 1 @ LOGICAL DATA B GNBLK 2 @ TEXT DATA B GNBLK 3 @ INTEGER DATA B GNBLK 4 @ REAL DATA B GNBLK 5 @ INDEX-SEQUENCE DATA B GDBLIST 6 @ * LIST B GNBLK 7 @ CODESTRING B GDBFUND 8 @ * FUNCTION DESCRIPTOR B GDBFUND 9 @ * FUNCTION DESCRIPTOR B GDBFUND A @ * FUNCTION DESCRIPTOR B GDBFUND B @ * FUNCTION DESCRIPTOR B GDBFUND C @ * FUNCTION DESCRIPTOR B GDBFUND D @ * FUNCTION DESCRIPTOR B GNBLK E @ INTRINSIC FUNCTION B GNBLK F @ INTRINSIC FUNCTION B GNBLK 10 @ INTRINSIC FUNCTION B GNBLK 11 @ GROUP B GNBLK 12 @ LONG-NAME * * NOTE--* INDICATES TYPES CONTAINING DB PTRS * GDBFUND STW,R1 GCTEMP SAVE PTR TO FUN.DESCR. DATA BLK. AI,R1 XSIZOFF PT AT XSIZE WD. LI,R11 X'E0000' CW,R11 0,R1 DOES IT PT AT ERR-CTRL TBL... BAZ GDBFUNDN NO. BAL,R7 DISPLACE YES, DISPLACE IT IF APPR. GDBFUNDN LW,R11 NFLOFF-XSIZOFF,R1 GET NO.OF LINES IN FUNCTION... BEZ GDBRR1 NONE -- FORGET IT. AI,R1 -XSIZOFF+NFLOFF+1 PT AT 1ST FUN.LINE DB PTR WD. BAL,R7 DISPLACE DISPLACE IT IF APPR. AI,R1 1 PT AT NEXT WD. BDR,R11 DISPLACE LOOP TILL PAST LAST FUN.LINE PTR WD. LI,R11 X'FFFF' EXTR. NO.OF LABEL ENTRIES. AND,R11 0,R1 BEZ GDBRR1 NONE. AI,R1 2 PT AT 1ST LABEL'S DB PTR WD. BAL,R7 DISPLACE DISPLACE IT IF APPR. AI,R1 2 PT AT NEXT ONE, IF ANY. BDR,R11 DISPLACE LOOP TILL PAST LAST LABEL ENTRY. B GDBRR1 * * * DISPLACE -- THIS IS A WEIRD ROUTINE -- HALF-OPEN, HALF-CLOSED. * * IT TESTS A DATA BLOCK POINTER TO DETERMINE IF IT REFERENCES A * * DATA BLOCK THAT WILL CHANGE ITS POSITION IN CORE DUE TO AN * * IMPENDING MOVE. IF NOT, THE ROUTINE SIMPLY EXITS. OTHERWISE * * THE POINTER IS ADJUSTED, DISPLACING ITS VALUE TO THE POSITION * * THAT DATA BLOCK WILL OCCUPY AFTER THE MOVE. THEN, THE * * ROUTINE DECREMENTS THE 'REFERENCE-ACCUMULATOR' WHICH INDICS. * * THE NO.OF DATA BLK PTRS STILL REQUIRING ADJUSTMENT. IF MORE * * REMAIN, THE ROUTINE EXITS, BUT AFTER ADJUSTING THE LAST SUCH * * PTR THE ROUTINE GOES ON TO PERFORM THE MOVEMENT OF DATA BLK * * REGIONS; IT BECOMES AN OPEN ROUTINE AT THIS POINT, BY THE WAY.* * THE DISPLACEMENT STRATEGY IS TO ADJUST PTRS IN THE * * FOLLOWING ORDER: * * 1. STRAY PTRS (IN PROCESSOR CONTEXT), * * 2. PTRS IN THE EXECUTION STACK, * * 3. PTRS IN THE SYMBOL TABLE, AND * * 4. PTRS CONTAINED INSIDE DATA BLOCKS. * * IF LUCKY, HOWEVER, THE REFERENCE-ACCUMULATOR WILL CLEAR * * QUICKLY -- SHORT-CUTTING THIS PROCEDURE, POSSIBLY EARLY IN * * STEP 1. * * * * REGS: R7 -- LINK (EXIT VIA 0,R7 UNTIL R3 CLEARS, THEN THE * * ROUTINE SWITCHES INTO OPEN PROCEDURE). * * R9 -- (ENTRY) MUST BE X'1FFFF' * * R1 -- (ENTRY) CONTAINS LOC.OF WD CONTAINING THE DATA * * BLOCK POINTER (OR NIL) TO BE TESTED. * * R3 -- REFERENCE-ACCUMULATOR. IT BETTER BE CORRECT. * * R6 AND R8 ARE VOLATILE. -- ------ -- -------- * * * DISPLACE LS,R8 0,R1 EXTR. THE ADDR. INDICATED VIA R1. BEZ 0,R7 NIL -- EXIT. CW,R8 FBOUNDS IS IT BELOW THE 1ST DATA BLK TO MOVE BL 0,R7 YES -- EXIT, THE DB PTR IS OK. LW,R6 NR2MOVE NO, DB PTR REQUIRE ADJUSTMENT; * GET NO.OF DATA REGIONS TO BE MOVED. DLOCQ AI,R6 -1 FIND THE HIGHEST REGION THAT IS CW,R8 FBOUNDS,R6 ABOVE THE DB PTR ADDRESS; THAT'S BL DLOCQ THE REGION CONTAINING THE ADDR. SW,R8 FAQMS,R6 ADJ. ADDR BY THE FREE ACCUMULATION STS,R8 0,R1 BELOW THAT DATA REGION. AI,R3 -1 DECR # OF REFS REMAINING TO MOVED BNEZ 0,R7 BLKS, AND EXIT IF ANY REMAIN. STW,R3 GCTEMP CLEAR THE MOVE-REGION COUNT. GMVSET MTW,1 GCTEMP BUMP THE MOVE-REGION COUNT. LW,R2 GCTEMP LW,R1 FBOUNDS,R2 = BOUND OF NEXT FREE BLOCK. SW,R1 FAQMS,R2 -(FREE ACCUMULATION BELOW THAT BND). STW,R1 FREETBL SET DESTINATION-BOUND FOR MOVE. AW,R1 FAQMS-1,R2 +(PRIOR FREE ACCUMULATION). STW,R1 FREETBL+1 SET SOURCE-BOUND FOR MOVE; IT IS * HIGHER THAN THE DESTINATION BOUND. LW,R1 FBOUNDS-1,R2 GET PRIOR FREE BLOCK BOUND. SW,R1 FREETBL+1 = -(NO.OF WDS TO MOVE). GMVQ CI,R1 -15 BIG OR SMALL BLK REMAINING... BLE GMV15 BIG -- MOVE 15 WDS OF THE BLK. LCW,R2 R1 SMALL, GET SIZE OF BLK LEFT TO GO. SCS,R2 -4 MOVE SIZE TO BITS 0 - 3. LC R2 SET COND. CODE = THAT SIZE. B GMV GMV15 LCI 15 SET COND. CODE FOR 15-WORD MOVE. GMV LM,R2 *FREETBL+1,R1 LOAD APPROACHING THE SOURCE-BOUND. STM,R2 *FREETBL,R1 STORE APPROACHING DESTINATION-BOUND. AI,R1 15 STEP UP BY 15 WORDS, AND LOOP UNTIL BLZ GMVQ LAST 1 TO 15 HAVE MOVED. MTW,-1 NR2MOVE DECR # OF REGIONS REMAINING TO MOVE. BGZ GMVSET MORE, SET UP FOR MOVING NEXT REGION. * DONE -- FREETBL NOW CONTAINS LOC OF * 1ST FREE WD IN COLLECTED FREE AREA LW,R1 FREETOTL SET SIZE OF THAT FREE TABLE ENTRY TO STW,R1 FREETBL+1 THE TOTAL THAT WERE FREE ORIG'NLY. * (ALL OTHER FREETBL WDS WERE ZEROED). LCI 0 RESTORE REGS, EXCEPT FOR R8. LM,R0 GARBSAVE B *LINKGC EXIT -- GARBAGE HAS BEEN COLLECTED. PAGE ************************************************************************ SPACE 2 Z SET %-WMAQ@ SIZE OF WMAQ IN HEX. SPACE Z SET Z+Z/10*6+Z/100*96+Z/1000*1536 SIZE IN DECIMAL. SPACE 2 END