File MANIP.MA (MACREL macro assembler source file)

Directory of image this file is from
This file as a plain text file

	TITLE	MANIP - PPL DATA MANAGEMENT AND MANIPULATION /TAS/EAT/21-JUL-74   
	SUBTTL	INITIALIZATION ROUTINES

	HISEG
	SEARCH	PPL		;CALL FOR PARAMETER DEFINITIONS

;'PZ.DZ.INIT' - PDZINI
;INITIALIZE THE PZ AND THE DZ TO CONTAIN NOTHING
;NO AC'S CLOBBERED


PDZINI:	MOVE	R,PZBEG		;GET POINTER TO FIRST PZ CELL
	MOVEM	R,LAPS		;INIT LIST OF AVAILABLE POINTERS
	ADDI	R,1		;PLACE IN EACH CELL THE ADDRESS OF THE NEXT
	MOVEM	R,-1(R)
	CAME	R,PZEND		;EXCEPT FOR THE LAST CELL
	AOJA	R,.-2
	SETZM	(R)		;WHICH GETS ZEROED TO MARK END OF CHAIN
	MOVE	R,DZBEG		;ZERO THE DATA ZONE
	MOVEM	R,NEXT
	SETZM	(R)
	HRLI	R,1(R)
	MOVS	R,R
	BLT	R,@DZEND
	PUSHJ	P,UPDZB1	;COMPUTE DZBDY1
				;FALL INTO SAVCLR AND RETURN

;ROUTINE TO CLEAR THE PZSAV LIST AND LEXSAV

SAVCLR:	SETZM	LEXSAV		;INDICATE NO LEXEMES TO PROTECT
	MOVE	R,[POINT 36,PZSTK-1,35]
	MOVEM	R,PZSAV		;RESET PZ SAVE STACK
	RETURN

;PPLINI ;ROUTINE TO INITIALIZE ALL PPL STANDARD INTERNAL TABLES PPLINI: MOVEI AC2,INIDAT ;FETCH ADR OF BEGINNING OF INITIAL BLOCK TBL PPLIN1: HRRZ AC1,(AC2) ;GET SIZE OF BLOCK TO BE GENERATED PUSHJ P,ALLOC ;ALLOCATE IT HRRZ B,@IDTP ;SETUP DZADR OF IDT IN CASE STORING INTO IT HRRM R,@1(AC2) ;STORE POINTER TO BLOCK IN REQUESTED LOC HLL R2,(AC2) ;FETCH LH DATA FOR PZWORD MOVEM R2,(R) ;STORE PZ WORD HRLI R2,1(AC2) ;CONSTRUCT BLT POINTER FOR MOVING DATA AOBJN R2,.+1 ADDI AC2,1(AC1) ;ADVANCE TO NEXT ENTRY IN INITIAL TABLE ADDI AC1,-2(R2) ;COMPUTE LAST LOC TO MOVE DATA INTO BLT R2,(AC1) ;TRANSFER DATA TO NEW BLOCK CAIGE AC2,INIEND ;AT END OF INITIALIZATION TABLE? JRST PPLIN1 ;NO, GO BACK AND DO MORE MOVEI R,RD ;STORE CHANNEL # FOR READ/WRITE/SAVE/RESTORE MOVEM R,RWFCB+FILEXT MOVEI R,HPCHAN+1 ;REAL CHANNEL # FOR USER CHANNEL #1 MOVSI R2,-NFCBLK ;NUMBER OF FILE CONTROL BLOCKS FCBCHN: MOVEM R,FCBLST+FILEXT(R2) ;STORE REAL CHANNEL NUMBER IN FCB ADDI R,1 ;NEXT CHANNEL # ADDI R2,FCBSIZ-1 ;ADVANCE TO NEXT FCB AOBJN R2,FCBCHN ;GO BACK FOR MORE RETURN
SUBTTL BLOCK ALLOCATION ROUTINES ;MKBLK ;MAKE A BLOCK OF SPECIFIED TYPE AND SIZE ; PUSHJ P,MKBLK ; BLKARG TYPE,SIZE ;TYPE MAY INCLUDE SYSBIT ;SIZE MAY BE INDIRECT AND/OR INDEXED ;RETURNS ADDRESS OF PZ WORD IN R AND ABS ADDR. OF BLOCK IN R2 MKBLK: PUSH P,AC1 PUSH P,@-1(P) ;FETCH IN-LINE ARG AND PUT ON STACK MOVEI AC1,@(P) ;COMPUTE EFFECTIVE BLOCK SIZE PUSHJ P,ALLOC ;R_PZ ADDR, R2_DZ (ABS) ADDR LDB AC1,[POINT 13,(P),12] ;GET TYPE FIELD TRZE AC1,10000 ;SET SYSBIT IF SPECIFIED TRO AC1,(SYSBIT) HRLM AC1,(R) ;STORE TYPE POP P,AC1 ;THROW AWAY STACKED ARG JRST S1 ;RESTORE AC1 AND SKIP RETURN
;ALLOC(N) ;ALLOCATE A BLOCK OF N WORDS IN THE DZ, SET UP POINTERS, AND RETURN ;THE ADDRESS OF THE PZ POINTER TO THE BLOCK. ;R2 IS RETURNED WITH THE ABSOLUTE ADDRESS OF THE ALLOCATED BLOCK. N== AC1 ;ARG - BLOCK SIZE TO BE ALLOCATED ALLOC: CALL HEAD ;GET ADDRESS OF FIRST AVAILABLE POINTER CELL SAVE R ;SAVE IT MOVE R2,NEXT ;GET ADDR OF FIRST FREE CELL IN DZ ADDI R2,-1(N) ;COMPUTE NEW END AFTER ALLOCATION CAMG R2,DZEND ;ROOM TO ALLOCATE THIS BLOCK? JRST ALLOCX ;YES, GO DO IT CALL GARCOL ;NO, GARBAGE COLLECT AND COMPACT TO FREE SPACE ALLOC1: MOVE R2,NEXT ;GET ADR OF FIRST FREE CELL IN DZ ADDI R2,-1(N) ;COMPUTE END AFTER ALLOCATION CAMG R2,DZBDY1 ;TEST AMOUNT OF SPACE RECOVERED JRST ALLOCX ;OK, GO DO ALLOCATION CALL ASKCOR ;INSUFFICIENT, ASK FOR 1K MORE JRST ALLOC3 ;FAILED. MAKE DO WITH WHAT WE HAVE CALL UPDZBS ;SUCCEEDED. UPDATE DZBDY1 AND DZEND IFN FTSTAT,< MOVE R2,DZEND ;COMPUTE NEW SIZE OF DZ SUB R2,DZBEG STAT .DZS,1(R2) ;REPORT NEW SIZE OF DZ > JRST ALLOC1 ;TEST LIMITS AGAIN ;HERE IF CORE EXPANSION FAILED ALLOC3: CAMLE R2,DZEND ;SEE IF BLOCK WILL FIT ANYWAY ERROR MSG(DZEXH) ;DATA ZONE EXHAUSTED ;HERE WHEN SUFFICIENT CORE IS AVAILABLE ALLOCX: RESTORE R ;GET BACK ALLOCATED PZ POINTER MOVE R2,NEXT ;GET ADR OF FIRST FREE CELL IN DZ MOVEM R2,(R) ;STORE POINTER TO IT MOVEM R,(R2) ;STORE BACK POINTER HRLM N,(R2) ;STORE BLOCK LENGTH ADDM N,NEXT ;UPDATE FREE POINTER IFN FTSTAT,< STAT .ALL,(N) ;OUTPUT ALLOCATION STATISTIC > RETURN ;RETURN. R=PZADR, R2=DZADR
;ROUTINE TO ALLOCATE A CELL IN THE PZ AND RETURN ITS ADDRESS IN R. ;IF NO FREE CELLS REMAIN, IT AUTOMATICALLY ATTEMPTS TO INCREASE THE SIZE ;OF THE PZ; IF UNSUCCESSFUL, IT EXITS TO THE MONITOR. HEAD: SKIPN R,LAPS ;GET ADDR OF FIRST FREE POINTER CELL IN CHAIN JRST NOHEAD ;NONE LEFT MOVE R2,(R) ;OK. FIX LAPS TO POINT TO NEXT CELL ON CHAIN MOVEM R2,LAPS SETOM (R) ;PROTECT CELL JUST ALLOCATED RETURN ;HERE IF THE POINTER CHAIN IS EMPTY. TRY TO EXPAND PZ BY 1K. NOHEAD: SAVE AC1 ;SAVE A TEMP MOVEI AC1,2000 ;PUT INCREMENT IN AC1 CALL ASKCOR ;REQUEST 1K MORE CORE FROM MONITOR JRST NOMOCO ;NO GOOD. GO TRY SWIPING FROM DZ CALL DZMOVE ;OK. MOVE DZ UP BY 1K RLNKPZ: MOVE R,PZEND ;GET FIRST CELL THUS LIBERATED ADDI R,1 HRLI R,-2000 ;PUT -SIZE OF LIBERATED SPACE IN LH HRRZM R,LAPS ;POINT TO START OF CHAIN AOBJN R,.+1 ;INCREMENT POINTER HRRZM R,-1(R) ;POINT EACH CELL TO NEXT AOBJN R,.-1 SETZM -1(R) ;PUT ZERO IN LAST CELL TO MARK END ADDM AC1,PZEND ;UPDATE PZ END POINTER RESTORE AC1 JRST HEAD ;GO BACK AND ALLOCATE A CELL.
;HERE IF THE PZ WAS EXHAUSTED AND NO MORE CORE IS AVAILABLE FROM THE MONITOR. ;WE TRY TO GET 1K FROM THE DATA ZONE BY SHIFTING IT UP 1K. NOMOCO: MOVE R,NEXT ;GET ADR OF FIRST UNUSED CELL IN DZ ADDI R,1777 ;SEE IF THERE IS 1K OF FREE SPACE CAMG R,DZEND JRST SWIPE ;YES, GO TAKE IT AWAY FOR PZ. CALL GARCOL ;NO, PERFORM A GARBAGE COLLECTION MOVE R,NEXT ;PERFORM CALCULATION AGAIN ADDI R,1777 CAMLE R,DZEND ;1K AVAILABLE NOW?????? ERROR MSG(PZEXH) ;POINTER ZONE EXHAUSTED ;HERE WHEN SUFFICIENT FREE SPACE EXISTS AT THE END OF THE DZ TO MOVE ;IT UP BY 1K. SWIPE: CALL DZMOVE ;SHIFT UP THE DZ SUBM AC1,DZEND ;NOW TAKE 1K AWAY FROM TOP MOVNS DZEND IFN FTSTAT,< MOVE R,DZEND ;COMPUTE NEW SIZE OF DZ SUB R,DZBEG STAT .DZS,1(R) ;REPORT DZ SIZE > JRST RLNKPZ ;NOW GO FIX UP THE PZ WITH 1K MORE CORE
;ROUTINE TO RELOCATE THE ENTIRE DATA ZONE UP BY THE INCREMENT IN AC1, ;WHICH MUST BE A MULTIPLE OF 2000(8) WORDS. THE POINTERS IN THE PZ ARE ;APPROPRIATELY UPDATED, AS ARE THE FOLLOWING CELLS: ; DZBEG,DZEND,DZBDY1,NEXT DZMOVE: SKIPE JOBDDT ;PRINT WARNING MESSAGE IF DDT LOADED OUTSTR [ASCIZ/[DZ MOVED] /] PUSHJ P,IOBSET ;PREPARE I/O BUFFERS FOR MOVING MOVE R,PZBEG ;GET ADR OF START OF PZ SUB R,PZEND ;COMPUTE LENGTH-1 MOVSI R,-1(R) ;PUT -LENGTH IN LH HRR R,PZBEG ;MAKE AOBJN POINTER FOR PZ PZFIX: HRRZ R2,(R) ;GET A PZ POINTER CAML R2,DZBEG ;POINT INTO DZ? ADDM AC1,(R) ;YES, UPDATE POINTER AOBJN R,PZFIX ;LOOP THRU ENTIRE PZ ;HERE TO SHIFT THE DZ UP. IT IS ASSUMED THAT THE CORE ACTUALLY EXISTS. ;THIS CODE MOVES THE DATA AS A SERIES OF BLOCKS. A SINGLE BLT MAY ;NOT BE USED HERE BECAUSE OF PROBLEMS WITH OVERLAPPING SOURCE AND TARGET ;BLOCKS. MOVUP: HRRZ R,NEXT ;GET FIRST FREE CELL ADDI R,-1 ;DECREMENT RH BY 1 AND PUT 1 IN LH ; SO AC1 CAN BE USED FOR INDEXING MOVUP1: MOVEI R2,1(R) ;GET ADR OF START OF TARGET BLOCK CAMG R2,DZBEG ;ARE WE AT BEGINNING OF DZ? JRST DZDONE ;YES, SHIFT IS FINISHED SUBI R2,(AC1) ;NO. COMPUTE START OF A BLOCK TO MOVE CAMGE R2,DZBEG ;DID THAT TAKE US BELOW DZ MOVE R2,DZBEG ;YES, SOURCE BLOCK STARTS THERE INSTEAD HRLI R2,(R2) ;PUT START IN LH AND RH ADDI R2,(AC1) ;MAKE BLT POINTER TO MOVE UP BY INCREMENT BLT R2,@R ;MOVE THE BLOCK SUBI R,(AC1) ;MOVE POINTER BELOW MOVED BLOCK JRST MOVUP1 ;GO BACK TO MOVE SOME MORE BLOCKS ;HERE TO FIX THE POINTERS AND EXIT DZDONE: ADDM AC1,DZBEG ;ADJUST DZ BEGIN POINTER ADDM AC1,DZEND ;ADJUST DZ END POINTER ADDM AC1,NEXT ;ADJUST POINTER TO FIRST FREE CELL ADDM AC1,DZBDY1 ;ADJUST GC CONTROL MARKER JRST IOBFIX ;FIX UP I/O BUFFERS AND RETURN
;ROUTINE TO INCREASE THE SIZE OF THE DZ BY 1K. IT IS ASSUMED ;THAT CORE HAS ALREADY BEEN OBTAINED FROM THE MONITOR. UPDZBS: MOVEI R,2000 ;ADD 1K TO END POINTER ADDM R,DZEND ;THEN FALL INTO UPDZB1 ;ROUTINE TO UPDATE DZBDY1 BY THE ALGORITHM: ; DZBDY1_DZEND-MIN(XTRADZ,(DZEND-DZBEG)/3) UPDZB1: MOVE R,DZEND ;COMPUTE LENGTH OF DZ SUB R,DZBEG IDIVI R,3 ;COMPUTE LENGTH/3 CAILE R,XTRADZ ;IS IT QUITE LARGE? MOVEI R,XTRADZ ;YES, DON'T WASTE CORE SUB R,DZEND ;R_-(DZEND-RESULT) MOVNM R,DZBDY1 ;STORE RESULTANT BOUNDARY RETURN REPEAT 0,< ;------ROUTINE NOT USED YET ;ROUTINE TO FIX UP ALL POINTERS AND BACK POINTERS IN THE DATA SPACE. ;CALLED UPON RECOVERY FROM CERTAIN CLASSES OF SYSTEM ERRORS THAT MIGHT ;LEAVE MALFORMED POINTER CYCLES, ETC. THIS ROUTINE CLEARS ALL ;GCBITS, CPYBITS, AND CHECKS ALL POINTER CYCLES, THEN PERFORMS A ;GARBAGE COLLECTION. DZFIX: MOVE R,PZBEG ;COMPUTE NEGATIVE LENGTH OF POINTER ZONE SUB R,PZEND MOVSI R,-1(R) ;PUT -LENGTH IN LH HRR R,PZBEG ;AND BEGIN ADDR IN RH DZFIX1: MOVSI R2,(GCBIT+CPYBIT) ;SET UP BITS TO BE RESET ANDCAB R2,(R) ;RESET THEM IN PZ WORD HLLI R2, ;CLEAR LEFT HALF FOR TEST CAMG R2,DZEND ;SEE IF IT POINTS INTO DZ CAMGE R2,DZBEG JRST .+2 ;NO, FORGET IT HRRM R,(R2) ;YES. RE-STORE BACK POINTER AOBJN R,DZFIX1 ;GO BACK FOR MORE ;FALL INTO GARCOL AND RETURN > ;------
SUBTTL GARBAGE COLLECTOR ;'GARBAGE.COLLECT' - GARCOL ;GARBAGE COLLECT AND COMPACT THE DATA ZONE. ;THIS FIRST CALLS ON A ROUTINE THAT SETS THE GCBIT IN EVERY POINTER ;THAT POINTS TO DATA WHICH IS TO BE SAVED. ALL THE REST WILL BE ;ELIMINATED AS GARBAGE. T== AC1 ;TEMPS TARGET==AC2 W== AC3 GARCOL: SKIPE JOBDDT ;WARN USER OF GC IF DDT IS LOADED OUTSTR [ASCIZ/[GC] /] PUSH P,T PUSH P,TARGET PUSH P,W PUSHJ P,MARKGC ;SET THE GCBIT IN ALL WORDS TO BE SAVED PUSHJ P,IOBSET ;PREPARE I/O BUFFERS FOR BEING MOVED IFN FTSTAT,< SETZM STDIST ;CLEAR BLOCK SIZE DISTRIBUTION TABLE MOVE T,[STDIST,,STDIST+1] BLT T,STDIST+DSTSIZ-1 > MOVE T,DZBEG ;POINT TO START OF DZ MOVE TARGET,T
;COMPACTIFYING LOOP CMPACT: CAMN T,NEXT ;AT END OF DZ? JRST CLRDZ ;YES HLRZ R,(T) ;NO, GET LENGTH OF DATA ITEM ADDRESSED BY T HRRZ W,(T) ;PICK UP BACK POINTER MOVE W,(W) ;GET PZ POINTER FOR THIS BLOCK TLZN W,(GCBIT+CPYBIT);IS THIS DATUM TO BE SAVED? JRST CLOSUP ;NO, THROW IT AWAY IFN FTSTAT,< CAIG R,DSTSIZ ;YES. BLOCK SIZE .LT. DSTSIZ? AOSA STDIST-1(R) ;YES, INCREMENT ENTRY IN DISTRIBUTION TABLE STAT .BIU,(R) ;NO, OUTPUT SEPARATE REPORT FOR THIS BLOCK > MOVE W,(W) ;GET BACK OLD (OR STALLMAN-TWIDDLED) DZ ADR HRRM TARGET,(W) ;ADJUST PZ POINTER TO NEW DZ POSITION CAIN T,(TARGET) ;IS THE BLOCK REALLY GOING TO MOVE? JRST NOMOV ;NO, DON'T WASTE TIME HRLZ W,T ;TRANSFER THE DATA BLOCK UP IN THE DZ HRR W,TARGET ADD TARGET,R BLT W,-1(TARGET) CLOSUP: ADD T,R ;MOVE TO NEXT DATA ITEM JRST CMPACT ;HERE WHEN BLOCK NOT ACTUALLY MOVING NOMOV: ADDI TARGET,(R) ;UPDATE TARGET POINTER JRST CLOSUP ;DO NEXT BLOCK ;NOW CLEAR THE NEWLY-FREED SPACE IN THE DATA ZONE CLRDZ: MOVEM TARGET,NEXT ;STORE NEW FREE POINTER CAMG TARGET,DZEND ;CHECK FOR UNLIKELY SATURATION POSSIBILITY SETZM (TARGET) CAML TARGET,DZEND JRST PZLNK HRL TARGET,TARGET ;MAKE BLT POINTER ADDI TARGET,1 BLT TARGET,@DZEND ;CLEAR THE FREE SPACE IN THE DZ IFN FTSTAT,< STAT .TBL,DSTSIZ ;SIGNAL DISTRIBUTION TABLE ABOUT TO BE OUTPUT MOVSI T,-DSTSIZ ;SETUP COUNTER DSTOUT: HRRZ R,STDIST(T) ;FETCH A DISTRIBUTION ENTRY STAT (R) ;OUTPUT 18-BIT VALUE AOBJN T,DSTOUT ;CONTINUE THRU ENTIRE TABLE >
;RE-LINK THE FREE SPACE IN THE POINTER ZONE, LINKING ALL POINTERS ;WITHOUT GCBIT SET INTO THE LAPS CHAIN. CLEAR GCBIT EVERYWHERE PZLNK: MOVSI W,(GCBIT) ;WORD TO CLEAR GCBIT WITH MOVE T,PZBEG ;GET PZ START SUB T,PZEND ;COMPUTE -LENGTH +1 MOVSI T,-1(T) ;MAKE AOBJN POINTER FOR PZ HRR T,PZBEG MOVEI R,LAPS ;ADDR OF PREVIOS FREE CELL MOVSI R2,(GCBIT+CPYBIT) ;MAKE BIT TEST CONSTANT NXTPZP: TDNN R2,(T) ;GCBIT OR CPYBIT SET ON THIS PZ WORD? JRST .+4 ;NO ANDCAM W,(T) ;YES, CLEAR GCBIT AND CONTINUE AOBJN T,NXTPZP JRST GCEXIT ;END OF PZ HRRZM T,(R) ;NOT SET, CHAIN WORD TO PREVIOUS ONE MOVE R,T ;SAVE THIS ADDR FOR NEXT LINK OF CHAIN AOBJN T,NXTPZP GCEXIT: SETZM (R) ;CLEAR FINAL PZ POINTER FOR END OF LAPS PUSHJ P,IOBFIX ;FIX UP POINTERS IN MOVED I/O BUFFERS MOVE T,NEXT ;FETCH FIRST FREE ADR ADDI T,4000 ;+2K CAML T,DZBDY1 ;MORE THAN 2K BELOW BOUNDARY? JRST X321 ;NO, LEAVE CORE ALLOCATION ALONE MOVNI T,2000 ;YES, REDUCE ALLOCATION BY 1K ADDB T,DZEND ;UPDATE END PTR CORE T, ;CALL MONITOR TO DECREASE ALLOCATION ERROR MSG(CORRF) ;CORE REDUCTION FAILED CALL UPDZB1 ;RECOMPUTE BOUNDARY IFN FTSTAT,< MOVE AC1,DZEND ;COMPUTE NEW SIZE OF DZ SUB AC1,DZBEG STAT .DZS,1(AC1) ;REPORT NEW SIZE OF DZ > JRST X321 ;RESTORE AC3,2,1 AND RETURN ;'ASK.FOR.CORE' - ASKCOR ;TRY TO EXPAND THE LOW SEGMENT 1K BEYOND DZEND. ;SKIPS IF SUCCESSFUL ASKCOR: HRRZ R,DZEND ;LAST CELL ALLOCATED ADDI R,2000 ;PLUS 1K CORE R, POPJ P, ;NO SUCCESS JRST CPOPJ1 ;OK
;ROUTINE TO PREPARE THE I/O BUFFERS TO BE MOVED, EITHER DURING GARBAGE ; COLLECTION OR BEFORE MOVING THE DATA ZONE. THIS ROUTINE FIRST ; CALLS WAIT ON THE CHANNEL, THEN FIXES UP THE POINTERS IN THE BUFFER ; HEADER AND THE BUFFER RING SO THAT THEY ARE RELATIVE TO THE START ; OF THE I/O BUFFER BLOCK. THIS IS SO THAT THE COMPANION ROUTINE ; IOBFIX CAN PROPERLY SET UP ABSOLUTE ADDRESSES AFTER THE BUFFERS ; HAVE BEEN MOVED. CLOBBERS R,R2 IOBSET: PUSHJ P,SAVE4 ;SAVE AC1-4 WITH AUTOMATIC RESTORE JSP AC1,ALLFCB ;DO THE FOLLOWING FOR ALL FCB'S HRRZ AC3,FILPZA(AC1) ;GET PZADR OF I/O BUFFER BLOCK JUMPE AC3,CPOPJ ;FORGET IT IF FILE NOT OPEN MOVE AC2,[WAIT] ;YES, SETUP WAIT UUO TO BE EXECUTED PUSHJ P,UXCT ;DO IT FOR THIS CHANNEL HRRZ AC3,(AC3) ;AC3_DZADR OF I/O BUFFER BLOCK MOVN AC2,AC3 ;AC2_SAME NEGATED ADDM AC2,FILHDP(AC1) ;MAKE HEADER POINTER IN FCB BE RELATIVE MOVEI R,-1 ;TEST WHETHER THE BYTE POINTER HAS TDNE R,FILPTR(AC1) ; EVER BEEN USED ADDM AC2,FILPTR(AC1) ;YES, RELATIVIZE IT AS WELL MOVE R,3(AC3) ;FETCH POINTER TO SECOND BUFFER FROM FIRST ADDM AC2,3(AC3) ;MAKE FIRST FORWARD POINTER BE RELATIVE ADDM AC2,(R) ;DO SAME TO SECOND (ONE IN 2ND BUFFER) POPJ P, ;RETURN ;ROUTINE TO PROPERLY FIX UP THE I/O BUFFERS AFTER THEY HAVE BEEN MOVED. ; MAKE ALL THE HEADER AND BUFFER RING POINTERS BE ABSOLUTE AGAIN, ; AND SET THE RING USE BIT TO SIGNAL THIS HAS HAPPENED. THEN, IF ; IT IS AN OUTPUT BUFFER, DO SOME MESSING AROUND SO THAT THE MONITOR ; IS AWARE OF THE NEW ADDRESS OF THE RING. IOBFIX: PUSHJ P,SAVE4 ;SAVE AC1-4 WITH AUTOMATIC RESTORE JSP AC1,ALLFCB ;DO THE FOLLOWING FOR ALL FCB'S HRRZ AC2,FILPZA(AC1) ;GET PZADR OF I/O BUFFER BLOCK JUMPE AC2,CPOPJ ;FORGET IT IF FILE NOT OPEN HRRZ AC2,(AC2) ;YES, AC2_DZADR OF I/O BUFFER BLOCK ADDM AC2,FILHDP(AC1) ;MAKE RING POINTER IN HEADER BE ABSOLUTE MOVEI R,-1 ;HAS THE BYTE POINTER EVER BEEN USED? TDNE R,FILPTR(AC1) ADDM AC2,FILPTR(AC1) ;YES, UPDATE IT ALSO MOVSI AC3,400000 ;PREPARE TO SET RING USE BIT IORB AC3,FILHDP(AC1) ;DO IT AND AC3_PTR TO CURRENT BUFFER HRRZ AC4,AC2 ;COPY DZ ADR ADDB AC4,(AC3) ;RELOCATE PTR TO OTHER BUFFER, AND ; AC4_PTR TO OTHER BUFFER ADDM AC2,(AC4) ;RELOCATE POINTER TO CURRENT BUFFER IN OTHER MOVEI R2,FS.OUT ;IS THIS AN OUTPUT BUFFER? TDNN R2,FILEXT(AC1) POPJ P, ;NO, FORGET IT
;CONTINUATION OF I/O BUFFER FIXUP CODE SKIPGE (AC4) ;ENSURE THE OTHER BUFFER IS EMPTY!!!!!! ERROR MSG(IOBFF) ;IOBFIX FAILED TDNE R,FILPTR(AC1) ;HAS THIS FILE EVER BEEN OUTPUT TO? PUSH P,FILCTR(AC1) ;YES, SAVE BYTE COUNTER PUSH P,FILPTR(AC1) ;SAVE CURRENT BYTE PTR HRRM AC4,FILHDP(AC1) ;TELL MONITOR WHERE OTHER BUFFER IS MOVSI AC2,(OUTPUT) ;SETUP UUO TO BE EXECUTED PUSHJ P,UXCT ;DO IT. THIS SHOULD JUST CLEAR OTHER BUFFER POP P,R ;GET BACK BYTE POINTER TRNN R,-1 ;HAS IT EVER BEEN USED? POPJ P, ;NO, NO NEED TO FIXUP DATA POP P,FILCTR(AC1) ;YES, RESTORE BYTE COUNTER SUBI R,(AC3) ;MAKE RELATIVE TO START OF CURRENT BUFFER ADDI R,(AC4) ;MAKE ABSOLUTE IN NEW BUFFER MOVEM R,FILPTR(AC1) ;STORE ADJUSTED BYTE PTR HRLI AC4,(AC3) ;SETUP CURRENT,,OTHER BUFFER ADDRESSES HLRZ R,(AC4) ;GET SIZE OF EACH BUFFER ANDI R,377777 ;MASK OUT USE BIT ADDI R,(AC4) ;COMPUTE ADR OF END OF OTHER BUFFER AOBJN AC4,.+1 ;ADVANCE PTRS TO CURRENT+1,,OTHER+1 BLT AC4,(R) ;TRANSFER DATA FROM CURRENT TO OTHER POPJ P, ;RETURN
;MARKGC ;SET THE GCBIT IN ALL PZ WORDS THAT ADDRESS DATA TO BE SAVED ;OVER GARBAGE COLLECTION ;****** AC'S 1-3 HAVE BEEN SAVED BY GARCOL ***** T== AC1 ;TEMPS (EXPLAINED IN MARK1) N== AC2 BLKP== AC3 SETGCB==AC4 MARKGC: PUSH P,SETGCB ;SET CONSTANT FOR MARKING PZ WORD MOVSI SETGCB,(GCBIT) HRRZ T,IDTP ;MARK THE IDT PUSHJ P,MARK1 HRRZ T,OPTP ;MARK THE OPT PUSHJ P,MARK1 SKIPE T,RAF ;MARK THE RAF IF ANY PUSHJ P,MKRING SKIPE T,RSF ;MARK THE RSF IF ANY PUSHJ P,MKRING MOVSI BLKP,-NFCBLK ;SETUP - # OF FILE CHANNEL BLOCKS MRKFCB: HRRZ T,FCBLST+FILPZA(BLKP) ;GET PZADR OF AN I/O BUFFER BLOCK PUSHJ P,MARK1 ;MARK I/O BUFFER BLOCK ADDI BLKP,FCBSIZ-1 ;ADVANCE TO NEXT FCB AOBJN BLKP,MRKFCB ;LOOP THRU FCB'S MOVEI BLKP,PZSTK ;COMPUTE NUMBER OF ENTRIES IN PZ SAVE STACK SUBI BLKP,@PZSAV ;THIS GIVES -(# OF ENTRIES -1) JUMPG BLKP,NOSAV ;SKIP AROUND IF NOTHING ON STACK MOVSI BLKP,-1(BLKP) ;OTHERWISE, PUT -NUMBER OF ENTRIES IN LH HRRZ T,PZSTK(BLKP) ;GET AN ENTRY (A PZADR) CALL MARK1 ;MARK IT AOBJN BLKP,.-2 ;LOOP THRU STACK NOSAV: HRLZ BLKP,LEXSAV ;GET NEG. # OF LEXEMES TO SAVE FOR LEX JUMPGE BLKP,MARKGX ;JUMP IF NONE MRKLEX: HRRZ T,LXMBUF(BLKP) ;GET RH OF A LEXEME HLRZ R,LXMBUF(BLKP) ;GET LH ANDCMI R,(BYTE(FCHNFS)-1) ;CLEAR FWD CHAIN FIELD CAIN R,(LXM(STAK,CONST)) ;IS IT A CONST? CALL MARK1 ;YES, MARK WHAT IT POINTS TO AOBJN BLKP,MRKLEX ;GO BACK FOR MORE LEXEMES MARKGX: POP P,SETGCB ;RESTORE AND EXIT POPJ P,
;MKRING ;MARK THE RING ADDRESSED BY T MKRING: SAVE T ;REMEMBER RING ADDRESS MKRNG1: HRRZ BLKP,(T) ;SAVE ABS ADDR OF AR PUSHJ P,MARK1 ;MARK AN AR HRRZ T,5(BLKP) ;GET PZADR OF RIGHT NEIGHBOR CAME T,(P) ;SAME AS RING ADDRESS? JRST MKRNG1 ;NO, MARK SOME MORE JRST X1 ;YES, HAVE GONE ALL THE WAY AROUND
;MARK1(T) ;MARK THE BLOCK (AND ALL INTERNALLY ADDRESSED SUBBLOCKS) POINTED TO ;BY ARGUMENT T, WHICH MUST HAVE ITS LEFT HALF CLEAR. T IS NOT ;PROTECTED, BUT N[RH] AND BLKP ARE PROTECTED. T== AC1 ;ARG - ADDRESS OF BLOCK N== AC2 ;SAVED TEMP - COUNTER BLKP== AC3 ;SAVED TEMP - INDEX OR BYTE POINTER INTO BLOCK SETGCB==AC4 ;CONSTANT WITH BIT 0 (GCBIT) SET MARK1: CAML T,PZBEG ;EXIT IF T NOT A PZ POINTER CAMLE T,PZEND RETURN HRLM N,(P) ;SAVE N[RH] ON STACK PUSH P,BLKP ;SAVE PREVIOUS POINTER SKIPGE BLKP,(T) ;GET PZ WORD AND SEE IF GCBIT SET JRST MARK1X ;YES, NO FURTHER MARKING NECESSARY ORM SETGCB,(T) ;NO, SET GCBIT NOW HLRZ R,BLKP ;GET SYSTEM OR USER INDEX ANDCMI R,(GCBIT+CPYBIT);CLEAR OTHER BITS TRZN R,(SYSBIT) ;A SYSTEM TYPE? JRST USRTYP ;NO, SWITCH ON USER-DEFINED TYPE JRST @MRKTBL-1(R) ;BRANCH ON SYSTEM TYPE INDEX ;DISPATCH TABLE FOR SYSTEM BLOCK MARKING DEFINE B.DEF(A) < EXP MK'A > MRKTBL: B.DEFS
;COME HERE TO EXIT FROM MARK1 ;THE FOLLOWING BLOCKS NEVER CONTAIN ADDRESSES, AND THUS WE ;CAN EXIT IMMEDIATELY MKTLINE: MKOPT: MKSTRUCT: MKALT: MKSEQ: MKVSEQ: MKLOGIC: ;THIS A GENERAL TYPE (CAN'T CONTAIN ADDRESSES) MKLIN0: MKCVAL: ;CVAL CONTAINS PZ PTRS TO AR'S MARKED ELSEWHERE MKIOB: ;IOB HAS PTR TO FCB, WHICH IS A PERMANENT OBJECT MARK1X: POP P,BLKP ;RESTORE OLD POINTER HLRE N,(P) ;RESTORE VALUE OF N MARKXX: POPJ P, ;MARK THE LINE ENTRIES OF A LINE SEQUENCE BLOCK MKLSB: HLRZ N,(BLKP) ;GET # OF LINES +1 SOJE N,MARK1X ;EXIT IF OUT OF LINES HRRZ T,1(BLKP) ;GET A PZ ADDRESS FOR A TLINE PUSHJ P,MARK1 AOJA BLKP,.-3 ;MOVE TO NEXT LSB ENTRY ;MARK THE ENTRIES OF THE IDT MKIDT: HLRZ N,(BLKP) ;GET LENGTH ADDI N,-2(BLKP) ;COMPUTE END-1 OF IDT MKIDT1: HRRZ T,1(BLKP) ;GET POINTER FIELD FROM STE PUSHJ P,MARK1 ;MARK REFERENCED ITEM LDB T,[POINT 6,2(BLKP),5] ;GET LENGTH OF IDT ITEM ADD BLKP,T ;ADD IT ON TO ADDRESS CAIL N,(BLKP) ;TEST FOR END OF IDT JUMPN T,MKIDT1 ;BACK FOR MORE IF ANOTHER SYMBOL JRST MARK1X
;MARK THE ENTRIES IN A FN MKFN: HLRZ N,2(BLKP) ;GET NUMBER OF LINES MOVEI BLKP,2(BLKP) ;PREPARE BYTE POINTER TO GET TEXT ENTRY HRLI BLKP,(POINT 18,0,17) ILDB T,BLKP ;GET A POINTER PUSHJ P,MARK1 ;MARK ITS BLOCK SOJGE N,.-2 JRST MARK1X ;MARK THE ENTRIES IN A LINE OF BASE-LANGUAGE TEXT MKLINE: HLRZ N,(BLKP) ;GET WLENGTH SUBI N,1 MKLIN1: SOJLE N,MARK1X ;EXIT IF OUT OF LEXEMES HLRZ R,2(BLKP) ;NO, GET LH OF LEXEME FOR TYPE CHECK HRRZ T,2(BLKP) ;GET POSSIBLE PZ ADDRESS CAIN R,(LXM(STAK,CONST)) ;IS IT A CONST? PUSHJ P,MARK1 ;ONLY CONST CONTAINS A PZ ADDRESS AOJA BLKP,MKLIN1 ;MARK THE REFERENCED DATA OF AN LVALUE MKLVAL: HRRZ T,1(BLKP) ;GET PZ ADDR OF DATA PUSHJ P,MARK1 ;MARK IT JRST MARK1X ;MARK SELECTED ITEMS IN AN AR ;NOTE: THE FOLLOWING ENTRIES DO NOT NEED MARKING ;LRING,RRING (MARKED DURING MARKGC SCAN THROUGH RINGS) ;CALLER,CALLED (ASSUMED TO BE MARKED, SINCE THEY MUST BE ON RAF OR RSF ;NOTE:: LINE.PTR MUST BE MARKED BECAUSE IMMEDIATELY-EXECUTABLE LINES ; DO NOT HAVE THEIR TEXT STORED ELSEWHERE MKAR: HLRZ T,1(BLKP) ;MARK FUNCTION FIELD (IN CASE USER ERASES PUSHJ P,MARK1 ; THE FUNCTION BEING EXECUTED) HRRZ T,2(BLKP) ;MARK LINE.PTR ENTRY PUSHJ P,MARK1 HLRZ N,(BLKP) ;GET REL ADDR OF END+1 OF AR SUBI N,6 ;COMPUTE # OF ITEMS, INCL PROCID,FORMLS,LCLS MKAR1: SOJL N,MARK1X ;EXIT IF OUT OF ITEMS HRRZ T,6(BLKP) ;GET AN ITEM FROM THE AR HLRZ R,6(BLKP) ;GET LH OF LEXEME ANDCMI R,(<<1_FCHNFS>-1>B<FCHNFP>) ;CLEAR FWD CHAIN FIELD CAIE R,(LXM(CXTWD,SUSCWD)) ;SUSPENSION CONTEXT WORD? CAIN R,(LXM(CXTWD,DMDCWD)) ;DEMAND CONTEXT WORD? JRST MKAR2 ;YES, MARK IT CAIE R,(LXM(STAK,SELX)) ;NO, A SELECTION EXPRESSION? CAIN R,(LXM(STAK,CONST)) ;OR A CONST? MKAR2: PUSHJ P,MARK1 ;YES, MARK OBJECT POINTED TO BY LEXEME AOJA BLKP,MKAR1 ;PREPARE TO MARK NEXT LEXEME
;MARK A USER REFERENCEABLE TYPE USRTYP: ADD R,@IDTP ;COMPUTE ADDR OF ITEM IN IDT HRRZ R2,(R) ;GET RH OF ITEM HLRZ R,(R) ;GET LH OF ITEM CAIN R,I.ATOM ;THIS TYPE AN ATOM? JRST MARK1X ;YES, NO FURTHER MARKING NECESSARY CAIE R,I.DDEF ;NO, BETTER BE A DDEF JRST DDFMIS ;UNKNOWN USER-DEFINED BLOCK TYPE HLRZ R,(R2) ;A DDEF, SEE WHAT KIND HRRZ R2,(R2) ;SET UP ABS ADDR OF DDEF BLOCK ANDCMI R,(GCBIT+SYSBIT+CPYBIT) CAIN R,B.STRUCT JRST DSTR ;A STRUCT, HAVE TO MARK EACH ADDRESSED ELEMENT CAIN R,B.SEQ JRST DSEQ ;A FIXED LENGTH SEQUENCE CAIN R,B.VSEQ JRST DVSEQ ;A VARIABLE SEQUENCE JRST DDFMIS ;ERROR, THIS BLOCK NOT A DDEF ;MARK EACH ITEM OF A FIXED SEQUENCE IF ITEMS ARE NON-ATOMIC DSEQ: HRRZ R,1(R2) ;GET ELEMENT TYPE FROM DDEF BLOCK CAIG R,U.NONE ;AN ATOM? JRST MARK1X ;YES, NOTHING FURTHER TO MARK ;MARK EACH ADDRESSED ELEMENT OF A BLOCK RECOGNIZED AS A STRUCT DSTR: HLRZ N,(BLKP) ;GET LENGTH OF DATA BLOCK DSTR1: SOJLE N,MARK1X ;EXIT IF OUT OF ITEMS HLRZ T,1(BLKP) ;NO, GET A PZ POINTER FROM LH PUSHJ P,MARK1 ;MARK IT HRRZ T,1(BLKP) ;GET A PZ POINTER FROM RH PUSHJ P,MARK1 ;MARK IT AOJA BLKP,DSTR1 ;MOVE ON TO NEXT WORD ;MARK EACH ITEM OF A VARIABLE SEQUENCE IF ITEMS ARE NON-ATOMIC DVSEQ: HRRZ R,1(R2) ;GET ELEMENT TYPE FROM DDEF BLOCK CAIG R,U.NONE ;AN ATOM? JRST MARK1X ;YES, NOTHING TO MARK HLRZ N,(BLKP) ;NO, GET LENGTH OF DATA BLOCK ADDI BLKP,1 ;PASS OVER ELEMENT COUNT IN DATA BLOCK SOJA N,DSTR1 ;GO MARK REFERENCED ENTRIES ;COME HERE IF A DATA DEFINITION IS MISSING. PROBABLY THE USER WAS ;CARELESS AND DELETED A DEFINITION WITHOUT DELETING DATA CREATED ;ACCORDING TO THAT DEFINITION. DDFMIS: TTOS MSG(ERDGC) ;INTERNAL ERROR DURING GARBAGE COLLECTION TTOS MSG(DDMIS) ;DATA DEFINITION MISSING JRST MARK1X ;TRY TO RECOVER.
SUBTTL UTILITY ROUTINES ;EXTEND(PT,N) ;EXTEND BY N WORDS THE BLOCK WHOSE PZ POINTER IS ADDRESSED BY PT. RETURN ;THE ABSOLUTE ADDRESS OF THE EXTENDED BLOCK. **** WARNING ******* ;EXTENSION IS ACCOMPLISHED BY ALLOCATING A NEW BLOCK OF THE PROPER SIZE ;AND TRANSFERRING THE OLD DATA TO THE BEGINNING OF IT. THE OLD PZ ;POINTER IS PROPERLY CHANGED TO POINT TO THE NEW BLOCK, BUT ABSOLUTE ;REFERENCES INTO THE DATA BLOCK ITSELF WILL NO LONGER BE VALID. PT== AC1 ;ARG - PZ POINTER TO BLOCK TO BE EXTENDED N== AC2 ;ARG - AMOUNT TO BE EXTENDED T== AC3 ;TEMP EXTEND: PUSH P,T HRRZ T,(PT) ;GET ABS. ADDR. OF BLOCK HLRZ T,(T) ;SAVE OLD WLENGTH ADD T,N ;COMPUTE AMOUNT NEEDED EXCH PT,T PUSHJ P,ALLOC ;ALLOCATE NEW SPACE MOVE PT,T HRRZ T,(PT) ;COMPUTE AMOUNT OF DATA TO BE MOVED FROM HLRZ R2,(T) ;THE OLD BLOCK TO THE NEW SOJE R2,.+6 ;SKIP ALL THIS IF OLD BLOCK WAS EMPTY ADD R2,(R) ;BLT FINAL ADDRESS HRLZ T,(PT) ;ADDR OF OLD BLOCK INTO T[LH] HRR T,(R) ;ADDR OF NEW BLOCK INTO T[RH] AOBJN T,.+1 ;DON'T WANT TO MOVE WLENGTH ANDBACK POINTERS BLT T,(R2) HRRZ T,(PT) ;SWAP POINTERS AND BACK POINTERS SO THAT HRRZ R2,(R) ;THE OLD PZ POINTER HITS THE NEW DATA BLOCK HRRM R2,(PT) ;OLD PZ POINTER _ ADDR OF NEW BLOCK HRRM PT,(R2) ;NEW BLOCK[BP] _ ADDR OF OLD PZ POINTER HRRM T,(R) ;NEW PZ POINTER _ ADDR OF OLD BLOCK HRRM R,(T) ;OLD BLOCK [BP] _ ADDR OF NEW PZ POINTER HRRZ R,R2 ;RETURN ABS ADDR OF NEW BLOCK POP P,T POPJ P,
;INSERT(PT,L,P1,RP) ;INSERT INTO THE DATA BLOCK WHOSE PZ POINTER IS ADDRESSED BY PT, AT ;RELATIVE POSITION RP, A BLOCK OF DATA ADDRESSED BY P1 AND OF LENGTH L. ;THIS ROUTINE SHOULD NOT BE CALLED DURING PPL EXECUTION, SINCE IT ;ASSUMES THE DATA BLOCK IS FULL AND THUS DOES AN EXTEND OPERATION EVERY ;TIME IT IS CALLED. PT== AC1 ;ARG - PZ POINTER TO BLOCK TO BE EXTENDED L== AC2 ;ARG - LENGTH OF INSERTED DATA ITEM P1== AC3 ;ARG - POINTER TO INSERTED DATA ITEM RP== AC4 ;ARG - RELATIVE POSITION AT WHICH DATA IS ;TO BE INSERTED INSERT: PUSH P,PT PUSH P,L PUSH P,P1 HRRZ P1,(PT) ;SAVE OLD WLENGTH HLRZ P1,(P1) PUSHJ P,EXTEND ;EXTEND THE BLOCK BY L WORDS SUB P1,RP ;P1_AMOUNT OF DATA THAT HAS TO BE SHIFTED UP HRRZ PT,(PT) ADD PT,RP ;PT_START ADDR OF DATA TO BE SHIFTED ADD L,PT ;L_WHERE IT HAS TO BE MOVED TO PUSHJ P,RBLT ;SHIFT IT HRL PT,(P) ;PREPARE TO INSERT L WORDS OF NEW DATA BLT PT,-1(L) POP P,P1 POP P,L POP P,PT POPJ P,
;RBLT(SA,DA,N) ;REVERSE-BLT OPERATION, FOR MOVING DATA TO HIGHER ADDRESSES IN CORE ;WHERE BLOCKS OVERLAP AND BLT MAY NOT BE USED. MOVES N WORDS STARTING ;AT SA, AND MOVES THEM TO THE ZONE STARTING AT DA. SA== AC1 ;ARG - SOURCE ADDRESS DA== AC2 ;ARG - DESTINATION ADDRESS N== AC3 ;NUMBER OF WORDS TO TRANSFER T== AC4 ;TEMP RBLT: JUMPE N,CPOPJ ;SKIP ALL THIS IF NO WORDS TO TRANSFER SAVE <AC1,AC2,AC3,AC4> SUB DA,SA ;DA_MOVE DISTANCE ADDI SA,-1(N) ;SA_ADDR. OF LAST SOURCE WORD HRLI SA,377777(N) ;SA[LH]_2^17-1+BLOCK SIZE HRLI DA,(POP SA,(SA));DA_"POP SA,DIST(SA)" MOVE N,[JUMPL SA,DA] ;LOAD INSTRUCTIONS FOR FAST LOOP MOVE T,[JRST X4321] JRST DA ;EXECUTE IN AC'S
;FINDID ;SEARCH THE IDT FOR THE ID IN STANDARD FORM IN LXBUF. IF NOT FOUND, ;ENTER THE NAME AT THE END OF THE IDT WITH A ZERO STE, EXTENDING THE ;IDT IF NECESSARY, AND SKIP EXIT. IN EITHER CASE, RETURN THE REL. ;ADDRESS (INTERNAL NAME) OF THE ID. T== AC1 ;TEMPS PT== AC2 FINDID: SAVE <T,PT> MOVSI R,PT ;USE R TO INDEX BY (PT) HRR R,@IDTP ;R[RH]_DZ ADDR OF IDT HLRZ R2,(R) ;R2_WLENGTH ADDI R2,(R) ;R2_ADDR+1 OF END OF IDT ADDI R,1 ;POINT R TO FIRST STE IDSRCH: CAIG R2,1(R) ;COMPARE R TO END+1 OF IDT JRST IDNOTF ;END OF TABLE REACHED LDB T,[POINT 6,1(R),5] ;GET LENGTH OF THIS IDT ENTRY MOVN T,T ;NEGATE IT HRLZ PT,T ;PLACE -LENGTH IN LH,0 IN RH AOBJP PT,IDNOTF ;JUMP IF LENGTH=0 (END OF ID'S) MOVE T,LXBUF-1(PT) ;GET A WORD FROM LXBUF CAMN T,@R ;COMPARE TO WORD IN IDT AOBJN PT,.-2 ;MATCHED, TRY NEXT WORD OF IDT JUMPGE PT,IDSX ;WHOLE ID MATCHED IF POSITIVE IDSNXT: AOBJN PT,. ;ADVANCE PT PAST REST OF CURRENT ID HRRI R,@R ;POINT R TO NEXT STE JRST IDSRCH ;TRY MATCHING THAT ONE ;COME HERE IF END REACHED WITH NO MATCH IDNOTF: LDB T,[POINT 6,LXBUF,5] ;GET LENGTH OF ID TO BE INSERTED ADDI T,(R) ;COMPUTE ADDR+1 OF LAST WORD NEEDED CAMG T,R2 ;SEE IF THAT ADDR IS WITHIN IDT JRST IDINS ;YES, GO INSERT THE NAME SUB R,@IDTP ;NO, SAVE REL. ADDR SAVE R MOVE AC1,IDTP ;AC1_PZ ADDR OF IDT MOVEI AC2,^D50 ;AMOUNT TO EXTEND IDT CALL EXTEND ;PERFORM IDT EXTENSION RESTORE R ADD R,@IDTP ;COMPUTE ABS ADDR OF INSERTION AGAIN HRLI R,PT IDINS: LDB T,[POINT 6,LXBUF,5] ;GET LENGTH OF ID TO INSERT MOVN T,T ;NEGATE IT HRLZ PT,T ;PT_NEG LENGTH,,0 AOBJN PT,.+1 ;POINT TO FIRST NAME WORD MOVE T,LXBUF-1(PT) ;GET A NAME WORD MOVEM T,@R ;STORE IN IDT AOBJN PT,.-2 AOS -2(P) ;SET SKIP EXIT IDSX: SUB R,@IDTP ;COMPUTE A RELATIVE ADDR HLLI R, JRST X21 ;RESTORE AC12,AC1 AND RETURN
;GETSTE(I) ;RETURN THE SYMBOL TABLE ENTRY ASSOCIATED WITH INTERNAL NAME I. I== AC1 ;ARG - INTERNAL NAME GETSTE: HRRZ R,@IDTP ;GET ADDR OF IDT ADD R,I ;POSITION IN IDT MOVE R,(R) ;RETURN THE WORD POPJ P, ;SETSTE(I,W) ;STORE W AS THE SYMBOL TABLE ENTRY ASSOCIATED WITH INTERNAL NAME I. I== AC1 ;ARG - INTERNAL NAME W== AC2 ;ARG - NEW CONTENTS SETSTE: HRRZ R,@IDTP ADD R,I MOVEM W,(R) POPJ P,
;FINDOP(T) ;SEARCH THE OPT FOR THE OP CONTAINED IN T. SKIP IF IT IS THERE, ;RETURNING ITS RELATIVE ADDRESS (INTERNAL NAME). IF NOT THERE, ;RETURN THE RELATIVE ADDRESS OF THE END + 1. T== AC1 ;ARG - NAME OF OP FINDOP: HRRZ R2,@OPTP ;GET ABS ADDR OF OPT SETCM R,(R2) ;PUT -WLENGTH-1 IN R[LH] HRRI R,-2(R2) ;PUT DZ START -2 IN R[RH] FOPNXT: ADD R,[3,,3] ;SEQUENCE PAST DISPATCH ENTRY JUMPGE R,FOPX ;EXIT IF END OF OPT CAME T,(R) ;SKIP IF OP NAME MATCHES JRST FOPNXT ;NO, TRY ANOTHER OP AOS (P) ;YES, SKIP EXIT FOPX: SUB R,@OPTP ;RETURN A RELATIVE POINTER HLLI R, ;WITH LH CLEAR RETURN ;ENTROP(T) ;ENTER THE OP IN T INTO THE OPT AT THE END ;RETURN THE REL ADDR (INTERNAL NAME) OF THE OP T== AC1 ;ARG - OP NAME ENTROP: PUSH P,AC1 ;SAVE AC'S FOR EXTEND CALL PUSH P,AC2 MOVE AC1,OPTP ;GET ADDR. OF OPT MOVEI AC2,3 ;AMOUNT TO BE EXTENDED PUSHJ P,EXTEND HLRZ R2,(R) ;COMPUTE REL ADDR OF END ADDI R,-3(R2) ;COMPUTE ABS ADDR OF OPT ENTRY POP P,AC2 POP P,AC1 MOVEM T,(R) ;STORE THE NEW OP JRST FOPX ;GO RETURN INTERNAL NAME
SUBTTL COPY ;ROUTINE TO COPY A USER DATUM, GIVEN ITS PZ ADDRESS IN ;AC1. RETURNS A PZ ADDRESS IN R. ;COPY ALGORITHM BY R. M. STALLMAN LEN==AC1 PZA==AC2 ;HOLDS ARGS TO INVOCATION OPZ==AC3 ;HOLDS OLD PZ WORD (USUALLY) RV==AC4 ;HOLDS VALUE TO BE RETURNED CNT==AC5 ;INVOCATION COUNT OBP==R ;HOLDS OLD DATA BLOCK'S BACK POINTER NPZ==R2 ;HOLDS NEW PZ WORD COPY: SAVE <LEN,PZA,OPZ,RV,CNT,B> HRRZ PZA,AC1 ;PUT ARG IN PZA FOR CPYTWO SETZ CNT, ;CPYTWO EXPECTS TWO ARGS IN THE HALVES OF PZA ;IT RETURNS TWO CORRESPONDING VALUES IN THE HALVES OF RV ;IT FIRST SWAPS THE HALVES OF PZA. THEN IT GOES THROUGH CPYONE ;WHICH HANDLES THE ARG THEN IN THE RH OF PZA, AND PLACES A VALUE IN ;THE RH OF RV. THEN CONTROL GOES TO CPYNXT, WHICH MOVES THE ARG IN ;THE LH OF PZA INTO THE RH, PUTS 7'S IN THE LH, AND GOES BACK TO ;CPYONE. CPYONE MOVES THE PREVIOUS VALUE FROM THE RH OF RV TO THE LH, ;HANDLES THE ARG WHICH IS IN THE RH OF PZA, AND PUTS A VALUE ;IN THE RH OF RV. THEN IT GOES TO CPYNXT AGAIN, WHERE THE H@LFWORD OF ;ONES IN LH OF PZA IS MOVED INTO THE RH. SINCE PZA IS THEN -1, CPYNXT ;DOESN'T GO BACK TO CPYONE, BUT RETURNS THRU CPYRTN INSTEAD. ;THE END RESULT IS THAT IF THE ARG IN LH OF PZA IS 0, 0 IS PUT IN THE ;LH OF RV, WHILE OTHERWISE IT IS HANDLED AND A RETURN VALUE IS PUT IN ;THE LH OF RV; THE ARG IN THE RH OF PZA IS SIMILARLY TREATED BUT 0 OR ;THE VALUE IS PUT IN THE RH OF RV. ;THE POINT OF THIS IS TO BE ABLE NOT TO SAVE ANYTHING BUT PZA. CPYTWO: SETZ RV, MOVS PZA,PZA ;SWITCH ORDER OF ARGS
;CPYONE HANDLES A SINGLE POINTER (IN RH OF PZA) AND RETURNS A ;SINGLE VALUE (IN RH OF RV, AFTER SHIFTING OLD RH UP) ;IF THE ARG IS 0, WE RETURN 0. ;IF THE PZ WORD ADDRESSED BY ITS ARGUMENT HAS A SET COPYBIT, WE TRACE ;POINTERS TO FIND THE NEW PZ WORD'S ADDR, AND RETURN IT. ;OTHERWISE, IF IT IS AN ATOM, WE RETURN THE ARGUMENT WE GOT. ;OTHERWISE, WE LOOK UP ITS DDEF, AND IF IT'S A SEQ OR VSEQ OF ATOMS, ;WE COPY IT INTO A NEW BLOCK, TWIDDLE THE POINTERS, AND SET ;THE COPY BITS, AND RETURN THE NEW BLOCK'S PZ ADDR. ;OTHERWISE,WE GET A NEW BLOCK, TWIDDLE POINTERS, SET COPY BITS, AND THEN ;FOR EACH WORD OF DATA, WE CALL OURSELVES WITH IT AS ARGUMENT, ;AND PUT THE RESULT IN THE CORRESPONDING POSITION IN ;THE NEW DATA BLOCK. WE RETURN ITS PZ ADDR. ;WHEN RECURRING, WE SAVE PZA ON THE STACK, RV IN THE NEW BLOCK'S 2ND ;WORD, AND OUR WORD PTR. THERE ALSO. CPYONE: HRLZI RV,(RV) ;PUT PREVIOUS VALUE IF ANY IN LH TRNN PZA,777777 ;IS ARG 0? JRST CPYNXT ;YES, RETURN 0. MOVE OPZ,(PZA) ;GET PZ WORD TLNN OPZ,(CPYBIT) ;IF IT'S BEEN COPIED, JRST NCPIED MOVE OBP,(OPZ) ;WE GET THE NEW PZ WORD'S ADDR CPNONE: HRRI RV,(OBP) ;AND RETURN IT JRST CPYNXT ;WE'RE THRU WITH THIS ONE NCPIED: HLRZ B,OPZ ;IF NOT COPIED, WE GET TYPE FIELD CAILE B,U.NONE ;IF IT'S ATOMIC, JRST NTATOM HRRI RV,(PZA) ;WE DON'T COPY, BUT RETURN OUR ARG JRST CPYNXT ;AND WE'RE DONE NTATOM: ADD B,@IDTP ;FIND THE DDEF MOVE B,(B) ;GET IT'S STE HLRZ NPZ,B ;IS IT A DDEF? CAIE NPZ,I.DDEF JRST CPYERR ;NO, QUIT COPYING AND UNTWIDDLE MOVE B,(B) ;GET IT'S PZ WORD HLRZ NPZ,B ;IF IT'S A STRUCTURE, CAIN NPZ,B.STRU(SYSBIT) JRST CPSTRU ;MAKE SURE THEY'RE TREATED AS POINTERS GET B,TYPF ;GET ELT. TYPE TO TEST LATER CAIN NPZ,B.VSEQ(SYSBIT) ;IF IT'S A VSEQ, SDT B'S SIGN HRROI B,(B)
;ALLOCATE NEW BLOCK, SWITCH THE BACK-POINTERS, SET THE COPYBITS NEWBLK: HLRZ LEN,(OPZ) ;GET BLOCK LENGTH CALL ALLOC MOVSI OPZ,(CPYBIT) ;PREPARE TO SET CPYBIT IORB OPZ,(PZA) ;SET IT, AND RETRIEVE DZ ADR IN CASE OF GC MOVE OBP,(OPZ) ;SWITCH THE BACK-POINTERS EXCH OBP,(NPZ) ;(NPZ=R2,WHICH ALLOC SET) MOVEM OBP,(OPZ) TLZE B,777777 ;AND NEW PZ WORD'S SYSBIT IF IT'S A VSEQ TLO OPZ,(SYSBIT) HLLM OPZ,(OBP) ;AND PUT TYPE IN NEW PZ WORD HLL NPZ,OPZ ;SAVE TYPE BITS SOJLE LEN,CPNONE ;IGNORE IF BLOCK LENGTH 1 (I.E.JUST BACK PTR) CAILE B,U.NONE ;NOW TEST ELT. TYPE JRST CPPTRS ;BLOCK CONTAINS POINTERS TO COPIABLE DATA ;ELTS. ARE ATOMS- COPY WITHOUT CHANGE CPATMS: HRLZI B,(OPZ) ;SET UP BLT POINTER HRRI B,(NPZ) AOBJN B,.+1 ;DON'T MOVE THE BACK-POINTER ADDI NPZ,(LEN) ;GET ENDING ADDR BLT B,(NPZ) HRRI RV,(OBP) ;RETURN NEW PZ WORD'S ADDR. JRST CPYNXT ;WE'RE DONE CPSTRU: MOVEI B,U.NONE+1 ;PRETEND TO BE A SEQ OF NON-ATOMS JRST NEWBLK ;REENTER MAIN SEQUENCE CPYERR: MOVNI B,1 ;INDICATE AN ERROR'S OCCURRED JRST CPYRTX ;AND RETURN UP THE LADDER CPERRX: POP P,PZA ;SO STACK WILL SURVIVE JRST CPYRTX ;AND RETURN
;ELTS. ARE POINTERS - CALL SELF FOR EACH WORD, STORE RETURNED VALUE. CPPTRS: HLLZM RV,1(NPZ) ;SAVE THE OTHER RETURNED VALUE, IF ANY PUSH P,PZA JRST CPENTR ;ENTER MAIN LOOP ;MAIN TRANSLATING LOOP CPREPT: HRRM LEN,1(NPZ) ;SAVE REL WORD POINTER ADDI OPZ,(LEN) ;FIND NEXT WORD TO HANDLE MOVE PZA,(OPZ) AOJA CNT,CPYTWO ;RECUR, WITH THAT WORD AS ARG RECRET: REFRSH PZA ;GET OUR ARGS BACK JUMPL B,CPERRX ;IF THERE WAS AN ERROR, GIVE UP MOVE OPZ,(PZA) ;GET THIS INVOC'S INFO BACK MOVE OBP,(OPZ) MOVE NPZ,(OBP) HRRZ LEN,1(NPZ) MOVEI B,(NPZ) ;FIND PLACE TO STORE TRANSLATED WORD ADDI B,(LEN) SOJE LEN,CPLAST ;IS THIS THE 2ND WORD(WHERE RV IS KEPT)? MOVEM RV,(B) ;NO,STORE TRANSLATED WORD CPENTR: CAIE LEN,1 ;WILL NEXT WORD DONE BE WORD 2 OF BLOCK? JRST CPREPT ;AND DO THE WORD BEFORE IT TLNN NPZ,(SYSBIT) ;IS IT A VSEQ? JRST CPREPT ;NO, HANDLE WORD 2 MOVE RV,1(OPZ) ;YES, MOVE IT UNCHANGED CPLAST: EXCH RV,1(NPZ) ;STORE IT BUT DON'T LOSE OUR RV HRRI RV,(OBP) ;RETURN NEW PZ WORD'S ADDR POP P,PZA ;GET IT OUT OF THE STACK ;DECIDE WHETHER WE'VE ANOTHER ARG TO HANDLE CPYNXT: HLRO PZA,PZA ;GET IT'S LH AOJE PZA,.+2 ;J IF WE'VE DONE BOTH SOJA PZA,CPYONE ;RESTORE PZA AND DO THE NEXT CPYRTN: SETZ B, ;INDICATE NO ERROR CPYRTX: SOJGE CNT,RECRET ;IF INNER INVOCATION, RET. TO SELF SETZ CNT, ;FOR CLRONE HRRZ PZA,-5(P) ;REFRESH ARG FROM STACK MOVE LEN,B ;SAVE ERROR INDICATION
;CLRONE IS A COPYBIT RESETTER AND UNTWIDDLER. ;IT HANDLES TWO ARGUMENTS, IN THE HALVES OF PZA, EITHER OR BOTH OF ;WHICH MAY BE 0. ARGS WHICH ARE 0 HAVE NO EFFECT.FOR EACH ARG: ;CLRONE SEES IF THE PZ WORD IT POINTS TO HAS COPY BIT SET. ;IF IT DOES NOT, CLRONE IS FINISHED WITH THE ARG. ;IF IT DOES, CLRONE UNTWIDDLES THE BACK POINTERS,RESETS THE COPY BITS, ;AND LOOKS AT THE TYPE FIELD OF THE PZ WORD, AND THE DDEF IT POINTS TO. ;IF IT IS A SEQ OR VSEQ OF ATOMS, CLRONE IS THRU WITH THE ARG. ;OTHERWISE,CLRONE CALLS ITSELF FOR EACH WORD OF THE BLOCK, EXCEPT ;FOR THE 2ND WORDS OF VSEQS(INDICATED BY THE SYSBIT) ;THEN IT IS THRU WITH THE ARG. ;WHEN IT IS THRU WITH AN ARG, IT GOES TO CLRNXT, WHICH GETS THE NEXT ;ARG AND GOES BACK, OR EXITS FROM THE INVOCATION. CLRONE: TRNN PZA,777777 ;IS THIS ARG 0? JRST CLRNXT ;NOTHING TO DO WITH IT MOVE OPZ,(PZA) ;GET PZ WORD TLZN OPZ,(CPYBIT) ;COPY BIT SET? JRST CLRNXT ;NO, NOTHING TO DO MOVEM OPZ,(PZA) ;YES, CLEAR IT MOVE OBP,(OPZ) ;GET BACK-POINTER MOVE NPZ,(OBP) ;GET NEW PZ WORD TLZ NPZ,(CPYBIT!SYSBIT) MOVEM NPZ,(OBP) ;CLEAR COPY BIT, SYSBIT (IN CASE VSEQ) EXCH OBP,(NPZ) ;UNTWIDDLE BACK-POINTERS MOVEM OBP,(OPZ) HLRZ OBP,OPZ ;GET TYPE FIELD CAIG OBP,U.NONE ;ATOMIC DATUM? JRST CLRNXT ;TES, WE'RE DONE WITH ARG ADD OBP,@IDTP ;NO, FIND DDEF'S STE MOVE B,(OBP) ;GET THE STE HLRZ OBP,B ;GET TYPE CAIE OBP,I.DDEF ;A DDEF? JRST CLRNXT ;NO, CAN'T TAKE CHANCE OF DOING ANYTHING MOVE B,(B) ;YES, GET IT'S PZ WORD HLRZ OBP,B ;GET TYPE CAIN OBP,B.STRU(SYSBIT) JRST CLRPTR ;IF STRUCTURE, TRACE POINTERS GET B,TYPF ;GET ELT. TYPE CAIG B,U.NONE JRST CLRNXT ;IF ATOMIC, WE'RE THRU WITH ARG. CAIN OBP,B.VSEQ(SYSBIT) TLO OPZ,(SYSBIT) ;IF IT'S A VSEQ, SET SYSBIT MOVEM OPZ,(PZA)
;BLOCK CONTAINS POINTERS - CALL SELF WITH EACH WORD OF THEM CLRPTR: HLRZ B,(OPZ) ;GET WLENGTH ADDI B,(OPZ) ;COMPUTE END+1 OF DATA BLOCK HRRM B,(OPZ) ;STORE IN BACK PTR SLOT FOR LATER CHECK PUSH P,PZA ;MAIN CALLING LOOP CLRCUR: REFRSH NPZ ;GET ARG BACK HRRZ OPZ,(NPZ) ;GET ADDR. OF BLOCK SOS OBP,(OPZ) ;DECREMENT WORD POINTER(IN BACK-PTR) CAIN OPZ,(OBP) ;NOW POINTS TO ITSELF? JRST CLRFIN ;YES, WE'VE DONE ALL POINTERS CAIE OPZ,-1(OBP) ;NEXT WORD WILL BE WORD 2? JRST .+4 ;NO, CALL SELF WITH IT MOVE OPZ,(NPZ) ;YES, GET WHOLE PZ WORD TLZE OPZ,(SYSBIT) ;IS THIS A VSEQ? JRST .+3 ;YES, DON'T HANDLE WORD MOVE PZA,(OBP) ;NO, GET NEXT WD OF POINTERS AOJA CNT,CLRONE ;CALL SELF WITH IT MOVEM OPZ,(NPZ) ;IF VSEQ, COME HERE AND CLEAR SYSBIT ;ALL WORDS OF POINTERS DONE CLRFIN: HRRM NPZ,(OPZ) ;MAKE BACK-PTR POINT BACK POP P,PZA ;GET ARG BACK INTO PZA CLRNXT: HLRZ PZA,PZA ;GET NEXT ARG IF ANY JUMPG PZA,CLRONE ;IF THERE IS ONE, HANDLE IT CLRRTN: SOJGE CNT,CLRCUR ;IF NOT OUTER INVOC, RET. TO SELF XCT CLRTAB(LEN) ;PERFORM APPROPRIATE EXITING ACTION RESTORE <B,CNT> ;RESTORE AC'S AND RETURN JRST X4321 MOVEI R,0 MOVEI R,1 ERROR MSG(DDMCP) ;DATA DEFINITION MISSING FOR DATUM BEING COPIED CLRTAB: MOVE R,RV LIT END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search