github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-07 03:15:54 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/sed/sed1ex.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1286 lines
43 KiB
Plaintext
Raw Permalink Blame History

TITLE SED1EX - SED ROUTINES FOR THE EXECUTE COMMAND
SUBTTL A CHRISTOPHER HALL FECIT
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1979,1983.
SEARCH SEDSYM
SALL
IFN TOPS10,<
SEARCH UUOSYM
TWOSEG
RELOC 400000
>
IFE TOPS10,<
SEARCH MONSYM
>
;HERE TO OPEN OR CLOSE THE EXECUTE BUFFER OR SET UP TO ITERATE IT A FEW TIMES
EXECUT::TLZ F,PCM ;CANCEL THE PICK-CLOSE MARK, IF ANY
TRZE F,CMV ;DID USER USE CURSOR MOVEMENT?
JRST [MOVE T3,[POINT 7,PARBUF]
PUSHJ P,PELS.M ;YES - READ PARAMETER FROM THE FILE
JRST EXECU1] ;CONTINUE
SETZ T1, ;END BUFFER WITH A NULL
IDPB T1,PARPTR
EXECU1: HLRZ T1,PARBUF ;GET FIRST CHARACTER OF PARAMETER
LSH T1,-^D11
ANDI T1,137 ;IF IT'S LOWER CASE, MAKE IT UPPER
CAIN T1,"S" ;SET UP A BUFFER?
JRST XCTSET ;YES - DO IT
CAIN T1,"K" ;KILL A BUFFER?
JRST XCTKIL ;YES - DO IT
CAIN T1,"W" ;WRITE INTO A BUFFER?
JRST XCTWRT ;YES - DO IT
CAIN T1,"R" ;READ AND LIST A BUFFER IN SWITCH FORMAT?
JRST XCTRDL ;YES - DO IT
CAIN T1,"L" ;READ AND LIST A BUFFER IN WRITE FORMAT?
JRST XCTRDW ;YES - DO IT
CAIN T1,"N" ;LIST THE DEFINED BUFFER NAMES?
JRST XCTNML ;YES - DO IT
CAIN T1,"X" ;WRITE AND EXECUTE BUFFER?
JRST XCTXCT ;YES - DO IT
CAIN T1,"B" ;LINK BUFFER TO A KEYBOARD BUTTON?
JRST XCTBTN ;YES - DO IT
CAIN T1,"@" ;READ A FILE OF BUFFER SWITCHES?
JRST XCTBSW ;YES - DO IT
;HERE TO SET UP A NUMBER OF ITERATIONS
EXCUT0: PUSHJ P,PEEL.1 ;READ PARAMETER, IF ANY
JUMPE T1,EXCOPN ;IF NO PARM, JUST OPEN EXECUTE BUFFER
MOVE T4,PARG1 ;ELSE GET NUMBER OF ITERATIONS
MOVE T3,T4 ;HERE, TOO
EXCH T4,XCTITR ;SAVE AS NEW NOMINAL
EXCUT1: EXCH T3,XCTNUM ;AND AS CURRENT NUMBER
SKIPGE T1,XCTACW ;GET BUFFER POINTER - IS THERE ONE?
JRST XCOERR ;NO - NO-ACTIVE-BUFFER ERROR
MOVE T1,XCTADR(T1)
ILDB T1,T1 ;MAKE SURE THERE'S SOMETHING THERE
JUMPE T1,XCXERR ;IF NOTHING THERE, ERROR
SKIPE XSHFLG ;WANT TO DISPLAY THE EXECUTE?
PUSHJ P,ERASPM ;YES - ERASE PARAMETER
TLNE TM,JRC ;DOING A JOURNAL RESTORE?
JRST EXCU1A ;YES - THEN IT'S A TOP-LEVEL EXECUTE
TRNE F,XCT!XBN ;ALREADY EXECUTING?
JRST EXCSVX ;YES - SAVE CONTEXT (RETURN TO EXCU1C)
EXCU1A: MOVE T1,[PARAMS,,SAVPRM]
BLT T1,SAVPRM+SAVPML-1 ;SAVE ALL PARAMETERS
HRRM F,SAVFGS ;ALSO SAVE RH OF F
HLLM TM,SAVFGS ; AND LH OF TM
TRZ F,XCT!XBN ;CLEAR JOURNAL-RESTORE FLAGS
TLZ TM,JRC
EXCU1B: SKIPE XSHFLG ;WANT TO DISPLAY THE EXECUTE?
TROA F,XBN ;YES - SET THE RIGHT FLAG
TRO F,XCT ;NO - SET THE RIGHT FLAG
EXCU1C: MOVE T1,XCTACW ;GET BUFFER POINTER
MOVE T1,XCTADR(T1)
MOVEM T1,XCTACR ;SET BUFFER UP FOR READING
MOVEM T1,XCTPTR
TRZE F,XSV ;SAVING COMMANDS?
PUSHJ P,XCTWIP ;YES - WIPE OUT THE "ENTER NUMBER EXECUTE"
JRST XCTEND ;FINISH OFF
;SUBROUTINE TO WIPE OUT THE EXECUTE COMMAND "ENTER SOMETHING EXECUTE"
;FROM THE BUFFER
XCTWIP: MOVE PT,XCTPTW ;GET POINTER TO END OF BUFFER
XCTWP1: ADD PT,[70000,,0] ;BACK IT UP A NOTCH
CAIGE PT,0 ;(USER TYPED "ENTER MUMBLE EXECUTE":
SUB PT,[430000,,1] ; WANT TO REMOVE THAT FROM BUFFER)
LDB T1,PT ;GET CHARACTER
CAIE T1,33 ;ENTER?
JRST XCTWP1 ;NO - KEEP SKIPPING
XCTCLO: SETZ T1, ;YES - SAVE A NULL OVER THE ENTER
DPB T1,PT
MOVEI T1,1 ;AND SET END-OF-BUFFER FLAG
ORM T1,(PT)
HRRM PT,XCFPTR ;SAVE NEW START-OF-FREE-SPACE POINTER
POPJ P, ;DONE
;HERE TO SAVE CURRENT BUFFER STATUS SO ANOTHER CAN BE EXECUTED
EXCSVX: SKIPE XCTPSV ;ALREADY DOWN A LEVEL?
JRST XSXERR ;YES - ONLY ONE STACK ALLOWED
MOVE T1,XCTPTR ;NO - SAVE ACTIVE BUFFER POINTER
MOVEM T1,XCTPSV
MOVE T1,XCTACR ;AND ACTIVE BUFFER STARTING POINTER
MOVEM T1,XCTASV
MOVEM T3,XCTNSV ;SAVE ACTIVE NUMBER OF ITERATIONS
MOVEM T4,XCTISV ;SAVE NOMINAL NUMBER OF ITERATIONS
JRST EXCU1C ;FINISH THE THE SET-UP
;HERE FOR JUST ENTER EXECUTE: OPEN BUFFER AND START SAVING COMMANDS
EXCOPN: TRO F,XSV ;SET FLAG TO SAVE COMMANDS
SETZM XCTITR ;CLEAR NUMBER OF ITERATIONS
SETZM XCTNUM
EXCOP1: SKIPGE T1,XCTACW ;IS THERE AN ACTIVE BUFFER?
JRST XCOERR ;NO - ERROR
MOVE T2,XCFPTR ;YES - GET POINTER TO START OF FREE SPACE
MOVEM T2,XCTPTW ;SAVE AS WRITE POINTER TO BUFFER DATA
MOVEM T2,XCTADR(T1) ; AND AS STORED POINTER TO BUFFER DATA
XCTEND: PUSHJ P,ERASPM
JRST DISCUR ;RE-POSITION CURSOR AND LOOP
;HERE TO SET UP AN EXECUTE BUFFER - IF GIVEN NAME IS NOT FOUND,
;CREATE BUFFER WITH THAT NAME
XCTSET::TRZE F,XSV ;WAS A BUFFER OPEN?
PUSHJ P,XCTWIP ;YES - CLOSE IT
PUSHJ P,XCTRED ;READ BUFFER NAME AND FIND IT
JUMPGE T1,XCTST1 ;JUMP IF FOUND
MOVEI T1,XBFNUM-1 ;ELSE CREATE IT - FIND OPEN SLOT
SKIPE XCTNAM(T1)
SOJGE T1,.-1 ;NOT OPEN - TRY AGAIN
JUMPL T1,XCSERR ;JUMP IF NONE OPEN - ERROR
MOVEM T4,XCTNAM(T1) ;SAVE NAME IN THIS SLOT
XCTST1: MOVEM T1,XCTACW ;SAVE INDEX OF ACTIVE BUFFER
TLZN F,FLG ;WANT TO RETURN TO A CALLER?
JRST XCTEND ;NO
POPJ P, ;YES
;SUBROUTINE TO ASK FOR AND FIND AN EXECUTE BUFFER. IF FOUND, THAT
;BUFFER IS MADE ACTIVE AND THE INDEX IS RETURNED IN T1.
;IF NOT FOUND THIS ROUTINE RETURNS -1 IN T1.
XCTFND: TRZE F,XSV ;WAS A BUFFER OPEN?
PUSHJ P,XCTWIP ;YES - CLOSE IT
PUSHJ P,XCTRED ;READ BUFFER NAME AND FIND IT
JUMPL T1,XCNERR ;ERROR - NAME NOT FOUND
MOVEM T1,XCTACW ;ELSE SAVE INDEX OF ACTIVE BUFFER
POPJ P, ;AND RETURN SUCCESS
;HERE TO KILL OFF A GIVEN EXECUTE BUFFER
XCTKIL: TRZE F,XSV ;WAS A BUFFER OPEN?
PUSHJ P,XCTWIP ;YES - CLOSE IT
PUSHJ P,XCTRED ;READ AND FIND NAME OF BUFFER
JUMPL T1,XCKERR ;NOT FOUND - ERROR
MOVE PT,T1
PUSHJ P,XCTKLL ;ELSE ZERO OUT ITS INFORMATION
CAMN T2,XCTACW ;IS THIS THE ACTIVE ONE?
SETOM XCTACW ;YES - SAY THERE IS NO ACTIVE BUFFER
JRST XCTEND ;DONE
XCTKLL: SETZM XCTNAM(PT) ;ZERO OUT BUFFER NAME
PUSHJ P,XCTKLF ;DELETE THE BUFFER CONTENTS FROM FREE SPACE
XCTKLK: SKIPN XCTKEY(PT) ;IS THERE A KEY?
POPJ P, ;NO - DONE
MOVE T2,[POINT 7,XCTKEY(PT)]
SETOM SAVEAC+6 ;RESTORE COMMAND IN TABLE
PUSHJ P,SUBTBX
SETZM XCTKEY(PT) ;CLEAN OUT OLD KEY
POPJ P,
;SUBROUTINE TO KILL THE CONTENTS OF AN EXECUTE BUFFER FROM FREE SPACE
;ENTER WITH PT/ BUFFER INDEX
XCTKLF: SKIPN T4,XCTADR(PT) ;GET EXECUTE BUFFER POINTER - ANY?
POPJ P, ;NO - NOTHING TO KILL
AOJ T4, ;YES - POINT TO FIRST WORD OF DATA
XCTKF1: MOVE T1,(T4) ;GET A BUFFER DATA WORD
TRNN T1,1 ;IS IT THE LAST WORD?
AOJA T4,XCTKF1 ;NO - LOOP UNTIL FOUND
SETZB T1,(T4) ;YES - TURN OFF THE END-OF-DATA FLAG
EXCH T1,XCTADR(PT) ;CLEAR AND GET POINTER TO START OF DATA
CAMN T4,XCFPTR ;DOES THIS DATA AREA BUTT AGAINST FREE SPACE?
MOVEM T1,XCFPTR ;YES - SAVE AS NEW START OF FREE SPACE
POPJ P, ;DONE
;HERE TO SAVE A STRING INTO THE ACTIVE BUFFER
XCTWRT: TRZE F,XSV ;WAS A BUFFER OPEN?
PUSHJ P,XCTWIP ;YES - CLOSE IT
MOVE PT,[POINT 7,PARBUF,6]
XCWRT0::MOVEM PT,SAVEAC ;SAVE THE POINTER TO THE NEW CONTENTS
SKIPGE PT,XCTACW ;GET POINTER TO OLD BUFFER CONTENTS - ANY?
JRST XCOERR ;NONE ACTIVE - ERROR
PUSHJ P,XCTKLF ;DELETE PREVIOUS CONTENTS FROM FREE SPACE
MOVE T4,XCFPTR ;GET POINTER TO START OF FREE SPACE
MOVEM T4,XCTADR(PT) ;SAVE AS TARGET POINTER
MOVE PT,SAVEAC ;GET POINTER TO NEW CONTENTS BACK
SETZ T0, ;CLEAR PARENTHETICAL COUNTER
XCWRT1: ILDB T1,PT ;GET A CHARACTER
XCWR1A: JUMPE T1,XCWEND ;DONE IF NULL
CAIGE T1," " ;SOME CONTROL CHARACTER?
JRST XCWRT1 ;YES - IGNORE IT
CAIN T1,"^" ;SOME COMMAND?
JRST XCWCMD ;YES - PURSUE IT
CAIN T1,"$" ;ENTER (OR ESCAPE)?
MOVEI T1,33 ;YES - SET IT UP
CAIN T1,")" ;MAYBE THE END OF A CONDITIONAL?
JUMPG T0,XCWRPE ;IF SO, END THE BLOCK
XCWRT2: PUSHJ P,XCTWO1 ;SAVE CHARACTER
JRST XCWRT1 ;AND GET ANOTHER
XCWCMD: ILDB T1,PT ;GET 1ST LETTER OF COMMAND NAME
CAIE T1,"$" ;REALLY WANT A REAL DOLLAR SIGN,
CAIN T1,")" ; OR CLOSE PAREN?
JRST XCWRT2 ;YES - JUST SAVE IT
CAIN T1,"/" ;HOW ABOUT A REAL SLASH?
JRST XCWRT2 ;YES - JUST SAVE IT
CAIN T1,"^" ;REALLY WANT AN UP-ARROW?
JRST [PUSHJ P,XCTWO1 ;YES - JUST GO SAVE IT TWICE
JRST XCWRT2]
CAIG T1,"9" ;NO - GOT A REPEAT COUNT?
JRST XCWRPT ;YES - SET COUNT UP
MOVEI T2,"^" ;NO - GET AN UP-ARROW
PUSHJ P,XCWGT1 ;PUT NEW CHARACTER IN WITH IT
PUSHJ P,XCWGET ;GET REST OF COMMAND NAME
CAME T2,["^RF"] ;GOT A ROLL FORWARD
CAMN T2,["^RB"] ; OR BACKWARD?
JRST XCWRT3 ;YES - NEED TO GET ANOTHER CHARACTER
LSH T2,^D15 ;NO - LEFT-JUSTIFY COMMAND NAME
XCWRT4: MOVEI T1,CMDLEN-1 ;LOOK FOR COMMAND AMONG NAMES
CAME T2,CMDNAM(T1) ;IS THIS IT?
SOJGE T1,.-1 ;NO - KEEP LOOKING
JUMPLE T1,XCWCON ;IF NOT FOUND, SEE IF IT'S A CONDITIONAL
CAIGE T1," " ;GOT A HIGH-NUMBERED COMMAND?
JRST XCWRT2 ;NO - O.K.
XCWRT5: MOVEI T2,"^" ;YES - PRECEDE IT WITH AN UP-ARROW
PUSHJ P,XCTWO2
JRST XCWRT2 ;THEN SAVE COMMAND
XCWRT3: PUSHJ P,XCWGET ;GET REST OF COMMAND NAME
LSH T2,^D8 ;LEFT-JUSTIFY COMMAND NAME
JRST XCWRT4 ;GO FIND THE COMMAND
XCWGET::ILDB T1,PT ;GET NEXT CHARACTER
XCWGT1: CAIL T1,"a" ;LOWER CASE?
SUBI T1,40 ;YES - CONVERT TO UPPER
LSH T2,7 ;SHIFT OVER ALREADY-GOTS
OR T2,T1 ;PUT NEW CHARACTER IN WITH THEM
POPJ P, ;DONE
;CONDITIONAL FLAGS: COND; DO, FR, FC, IF, DW, NOT
;IF DO FLAG, THEN REST OF BYTE (5 BITS) IS HIGH ORDER OF COUNT
;IF FC, FR, OR F. THEN THREE LOW FLAGS ARE: EQU, GRTR, NOT
;ALSO, 100 IS END OF A DO BLOCK AND 101 IS END OF AN IF
XCWCON: JUMPE T1,[MOVEI T1,77 ;IF RESET, SAVE "^",77
JRST XCWRT5]
MOVEI T1,CMDCLN-1 ;LOOK FOR CONSTRUCT AMONG THE NON-COMMANDS
XCWCN0: MOVE T3,CMDCON(T1) ;GET A NON-COMMAND
TRZ T3,77777 ;KEEP ONLY 1ST 3 CHARACTERS
CAME T2,T3 ;IS THIS IT?
SOJGE T1,XCWCN0 ;NO - KEEP LOOKING
JUMPL T1,XCWERR ;ERROR IF NOT FOUND
LDB T2,[POINT 7,CMDCON(T1),35] ;ELSE GET TYPE FLAGS
TRNN T2,100 ;GOT A CONDITIONAL?
JRST XCWCNX ;NO - CHECK FURTHER
CAIN T2,102 ;GOT A DO WHILE?
SKIPA T1,[100] ;YES - STACK DO'S END CHARACTER
MOVEI T1,101 ;ELSE STACK IF'S
PUSH P,T1 ;STACK IT, ALREADY
MOVEI T1,"^" ;START CONDITIONAL BLOCK
PUSHJ P,XCTWO1
TRNE T2,30 ;GOT IF-ROW, -COLUMN, OR -COUNTER?
JRST XCWCNF ;YES - GO READ CONDITION AND NUMBER
XCWCN1: ILDB T1,PT ;GET NEXT CHARACTER
CAIE T1,"^" ;"NOT" OR CHARACTER CLASS?
JRST XCWCN2 ;NO - FINISH OFF
;VALUES ARE: SPACE (5), NUMBER (3), ALPHA (LETTER) (1), UPPER CASE (6),
;ALPHA-NUMERIC (4), END OF LINE (2), CHARACTER == NOT SPACE
;ALSO, BLOCK OF CHARACTERS OR CONDITIONS TO BE OR'D STARTS WITH ^< (20)
; AND ENDS WITH > (21).
ILDB T1,PT ;GET NEXT CHARACTER
CAIN T1,"(" ;GOT A REAL OPEN PAREN?
JRST XCWCN2 ;YES - TREAT IT LIKE THE CHARACTER IT IS
REPEAT 0,<
CAIN T1,74 ;GOT THE START OF A CONDITIONAL BLOCK?
JRST XCWCBS ;YES - SET TO CALL THIS STUFF MANY TIMES
CAIN T1,76 ;GOT THE END OF A CONDITIONAL BLOCK?
JRST XCWCBE ;YES - NOTE THAT THE BLOCK IS OVER
>
ANDI T1,137 ;CONVERT LOWER CASE TO UPPER
CAIGE T1,"A" ;GOT SOME REAL LETTER?
JRST XCWERR ;NO - IT'S AN ERROR FROM THE START
CAIN T1,"X" ;GOT A "NOT" FLAG?
JRST [TRO T2,1 ;YES - SET THE FLAG
JRST XCWCN1] ;GO GET THE CHARACTER OR CLASS
CAIN T1,"L" ;CHECK CLASS: LETTER?
MOVEI T1,1 ;YES - GET VALUE
CAIN T1,"N" ;NUMERIC?
MOVEI T1,3 ;YES - GET VALUE
CAIN T1,"E" ;END OF LINE?
MOVEI T1,2 ;YES - GET VALUE
CAIN T1,"A" ;ALPHA-NUMERIC?
MOVEI T1,4 ;YES - GET VALUE
CAIN T1,"U" ;UPPER CASE?
MOVEI T1,6 ;YES - GET VALUE
CAIN T1,"C" ;ANY CHARACTER?
TROA T2,1 ;YES - SET "NOT" AND SPACE VALUE
CAIN T1,"S" ;SPACE CHARACTER?
MOVEI T1,5 ;YES - SET VALUE
CAILE T1,6 ;GOT A LEGAL VALUE?
JRST XCWERR ;NO - MISTAKE
PUSHJ P,XCTWO2 ;SAVE FLAGS
MOVEI T2,"^" ;SAVE CLASS FLAG
XCWCN2: PUSHJ P,XCTWO2
PUSHJ P,XCTWO1 ;SAVE CLASS TO LOOK FOR
ILDB T1,PT ;GET CHARACTER AFTER CONDITIONAL
JRST XCWRPX ;SKIP "(", IF ANY, AND LOOP
XCWCNX: MOVEI T1,"^" ;SAVE AN UP-ARROW
PUSHJ P,XCTWO1
PUSHJ P,XCTWO2 ;THEN SAVE COMMAND
CAIN T2,16 ;IS IT OUTPUT?
JRST XCWCXO ;YES - READ AND SET UP THE STRING
CAIE T2,15 ;IS IT INITIALIZE?
CAIN T2,21 ; OR DO-ON-SEARCH-FAILURE?
JRST XCWCX1 ;YES - GO STACK
CAIE T2,10 ;IS IT ITERATE-COUNTER?
JRST XCWRT1 ;NO - LOOP
XCWCX1: PUSH P,[100] ;YES - STACK THE END-REPEAT CHARACTER
ILDB T1,PT ;GET NEXT CHARACTER
JRST XCWRPX ;SKIP "(", IF ANY, AND LOOP
;HERE FOR THE OUTPUT CONSTRUCT - SAVE CHARACTERS UNTIL A ")"
XCWCXO: ILDB T1,PT ;GET THE "(" AFTER THE "^OU"
CAIE T1,"(" ;IS IT REALLY AN OPEN PAREN?
JRST XCWERR ;NO - ERROR
XCWXO1: ILDB T1,PT ;GET A CHARACTER TO OUTPUT
JUMPE T1,XCWERR ;ERROR IF END OF BUFFER REACHED
CAIN T1,")" ;END OF STRING?
JRST XCWXOE ;YES - FINISH OFF
CAIN T1,"$" ;WANT AN ESCAPE?
MOVEI T1,33 ;YES - GET ONE
CAIN T1,"^" ;WANT A CONTROL CHARACTER?
PUSHJ P,XCWXOC ;YES - CONVERT THE NEXT CHARACTER
PUSHJ P,XCTWO1 ;SAVE THE CHARACTER
JRST XCWXO1 ;AND GET ANOTHER
XCWXOC: ILDB T1,PT ;GET THE CONTROL CHARACTER
CAIE T1,"$" ;WANT A REAL DOLLAR SIGN,
CAIN T1,")" ; OR CLOSE PAREN?
POPJ P, ;YES - GO SAVE IT
ANDI T1,37 ;NO - MAKE IT A CONTROL CHARACTER
POPJ P, ;RETURN TO SAVE IT
XCWXOE: MOVEI T1,177 ;END THE STRING
PUSHJ P,XCTWO1
JRST XCWRT1 ;AND GET MORE INPUT
;HERE FOR IF-ROW, -COLUMN, OR -COUNTER
XCWCNF: ILDB T1,PT ;GET CONDITION OF THE IF (G, L, E, N)
ANDI T1,137 ;CONVERT LOWER CASE TO UPPER
CAIN T1,"G" ;GREATER?
TRO T2,2 ;YES - SET FLAG
CAIN T1,"L" ;LESS?
TRO T2,3 ;YES - SET FLAGS
CAIN T1,"E" ;EQUAL?
TRO T2,4 ;YES - SET FLAG
CAIN T1,"N" ;NOT EQUAL?
TRO T2,5 ;YES - SET FLAGS
TRNN T2,7 ;ARE ANY FLAGS AT ALL SET?
JRST XCWERR ;NO - ERROR
ILDB T1,PT ;YES - GET FIRST DIGIT OF ROW OR COLUMN
JRST XCWRP0 ;READ AND SAVE NUMBER OF ROW OR COLUMN
XCWRPT: PUSH P,[100] ;STACK THE END-REPEAT CHARACTER
MOVEI T2,"^" ;ANNOUNCE START OF COUNT
PUSHJ P,XCTWO2
MOVEI T2,140 ;GET FLAGS TO INDICATE A "DO"
XCWRP0: HRREI T3,-60(T1) ;CONVERT CHARACTER TO A DIGIT
JUMPL T3,XCWERR ;ERROR IF NOT NUMERIC
XCWRP1: ILDB T1,PT ;GET NEXT CHARACTER
CAIG T1,"9" ;NUMERIC?
CAIGE T1,"0"
JRST XCWRP2 ;NO - END OF COUNT
SUBI T1,"0" ;MAYBE - CONVERT TO A DIGIT
IMULI T3,^D10 ;SHIFT OVER THE OLD STUFF
ADD T3,T1 ;PUT NEW DIGIT IN
JRST XCWRP1 ;AND GET ANOTHER ONE
XCWRP2: TRNN T2,40 ;GOT DO, OR FR/FC/F.?
JRST XCWRP3 ;FR/FC/F. - PUT COUNT IN ONE BYTE
ROT T3,-7 ;GET HIGH-ORDER COUNT BITS
OR T2,T3 ;SET THEM IN FLAG WORD
ROT T3,7 ;GET LOW BITS BACK
XCWRP3: PUSHJ P,XCTWO2 ;SAVE FLAGS AND HIGH BITS
PUSHJ P,XCTWO3 ;SAVE REST OF REPEAT COUNT
XCWRPX: CAIN T1,"(" ;GOT START OF THE REPEAT BLOCK?
AOJA T0,XCWRT1 ;YES - IGNORE IT
AOJA T0,XCWR1A ;ELSE PROCESS CHARACTER, WHATEVER IT IS
XCWRPE: MOVEI T1,"^" ;MARK THE END OF THE REPEAT SECTION
PUSHJ P,XCTWO1
POP P,T1 ;GET FLAVOR OF REPEAT
PUSHJ P,XCTWO1 ;STORE IT
SOJA T0,XCWRT1 ;GET NEXT CHARACTER
XCWEND: SETZ T1, ;END BUFFER WITH A NULL
IDPB T1,T4
MOVEI T2,1 ;AND SET END-OF-DATA FLAG IN LAST WORD
ORM T2,(T4)
HRLI T4,010700 ;MAKE FREE POINTER BE START OF NEXT WORD
MOVEM T4,XCFPTR ;SAVE IT
EXCH T1,XCTLVL ;CLEAR OVERFLOW FLAG
JUMPL T1,XCVERR ;ERROR IF IT OVERFLOWED
JUMPG T0,XCWEN1 ;ERROR IF SOME CONDITIONAL NOT CLOSED
TLZN F,FLG ;WANT TO RETURN (TO SWHMNY)?
JRST XCTEND ;NO
POPJ P, ;YES
XCWEN1: POP P,T1 ;POP SAVED CONDITIONALS OFF STACK
SOJG T0,XCWEN1 ;THEN GIVE ERROR MESSAGE
MOVEI T1,[ASCIZ /###Conditional block not closed/]
JRST ERROR
XCWERR: MOVEI T1,[ASCIZ /#########Bad command name/]
JRST ERROR
XCTWO3: IDPB T3,T4 ;OUTPUT CHARACTER IN T3
JRST XCTWOU
XCTWO2: IDPB T2,T4 ;I MEAN IN T2
JRST XCTWOU
XCTWO1: IDPB T1,T4 ;I MEAN IN T1
XCTWOU: CAME T4,XCTOVF ;IS BUFFER ABOUT TO OVERFLOW?
POPJ P, ;NO - O.K.
MOVEI T1,1 ;LIGHT END-OF-DATA BIT
ORM T1,(T4)
PUSHJ P,XCGARB ;DO A GARBAGE COLLECT
MOVEI T1,1 ;CLEAR THE END-OF-DATA BIT
ANDCAM T1,(T4)
CAME T4,XCTOVF ;WAS ANYTHING RECOVERED?
POPJ P, ;YES - DONE
MOVE T4,XCTACW ;NO - RESET CURRENT WRITE POINTER
MOVE T4,XCTADR(T4)
SETOM XCTLVL ;NOTE THAT BUFFER OVERFLOWED
POPJ P, ;READ REST OF BUFFER
;SUBROUTINE TO GARBAGE COLLECT THE EXECUTE FREE SPACE (XCTFRE)
;RETURNS POINTER TO LOWEST FREE ADDRESS IN T4
;USES T0-T3
XCGARB: MOVEI T4,XCTFRE-1 ;POINT TO START OF FREE SPACE
XCGAR1: MOVEI T0,-1 ;LOOK FOR SMALLEST POINTER - START BIG
MOVEI T3,XBFNUM-1 ;LOOK THROUGH ALL BUFFER POINTERS
XCGAR2: SKIPE T1,XCTADR(T3) ;IS THIS POINTER ACTIVE?
CAILE T4,(T1) ;YES - IS ADDRESS GREATER THAN START OF F.S.?
JRST XCGAR3 ;NOT ACTIVE OR TOO SMALL - GET ANOTHER
CAIG T0,(T1) ;IS ADDRESS LESS THAN LOWEST SO FAR?
JRST XCGAR3 ;NO - SKIP IT
HRR T0,T1 ;YES - SAVE NEW ONE INSTEAD
MOVE T2,T3 ;SAVE INDEX, TOO
XCGAR3: SOJGE T3,XCGAR2 ;LOOP THROUGH ALL POINTERS
CAIN T0,-1 ;IS THERE A LOWEST POINTER?
JRST XCGARD ;NO - FINISH OFF
MOVE T3,T0 ;PUT ADDRESS IN AN INDEXABLE AC
HRRM T4,XCTADR(T2) ;SAVE NEW POINTER TO BUFFER DATA
XCGAR4: MOVE T1,1(T3) ;GET A WORD
MOVEM T1,1(T4) ;SAVE IT
TRNE T1,1 ;END OF THE DATA?
JRST XCGAR5 ;YES - FINISH
AOJ T3, ;NO - BUMP POINTERS
AOJA T4,XCGAR4 ; AND LOOP
XCGAR5: CAME T3,T4 ;DONE MOVING - WAS IT REALLY A MOVE?
SETZM T1,1(T3) ;YES - CLEAR FLAG IN OLD LAST WORD
AOJA T4,XCGAR1 ;DO ANOTHER PASS TO FIND NEXT DATA TO MOVE
XCGARD: HRLI T4,010700 ;MAKE F.S. ADDRESS INTO A POINTER
POPJ P, ;RETURN
;HERE TO WRITE THE ACTIVE BUFFER
;AND THEN EXECUTE IT THE GIVEN NUMBER OF TIMES
XCTXCT: TRZE F,XSV ;WAS A BUFFER OPEN?
PUSHJ P,XCTWIP ;YES - CLOSE IT
MOVE PT,[POINT 7,PARBUF,6] ;POINT TO 2ND CHARACTER OF PARAMETER
MOVE T4,[POINT 7,PARBUF] ;AND TO ITS START
XCTXC1: ILDB T1,PT ;SHIFT EXECUTE COUNT LEFT A NOTCH
CAIL T1,"0" ;IS THIS A DIGIT?
CAILE T1,"9"
JRST XCTXC2 ;NO - GOT IT ALL
IDPB T1,T4 ;YES - SAVE IT AND GET MORE
JRST XCTXC1
XCTXC2: CAIE T1,":" ;DOES THE NUMBER END WITH A COLON?
PUSHJ P,XCBKPT ;NO - BACK UP OVER THE LATEST CHARACTER
SETZ T1, ;END COUNT WITH A NULL
IDPB T1,T4
TLO F,FLG ;SET TO GET A RETURN FROM XCTWRT
PUSHJ P,XCWRT0 ;WRITE INTO THE BUFFER
JRST EXCUT0 ;SET UP AND EXECUTE THE NEW BUFFER
;SUBROUTINE TO BACK UP THE POINTER IN AC PT A NOTCH
;NOT USED MUCH. WHY SPEND TWO EXTRA INSTRUCTIONS?
XCBKPT: ADD PT,[70000,,0]
JUMPGE PT,CPOPJ
SUB PT,[430000,,1]
POPJ P,
;HERE TO OUTPUT THE CONTENTS OF THE ACTIVE BUFFER IN WRITE FORMAT
XCTRDW: MOVE T1,[260700,,PARBUF]
CAMN T1,PARPTR ;HAS A NAME BEEN GIVEN?
JRST XCRDWC ;NO - READ THE ACTIVE BUFFER
PUSHJ P,XCTFND ;YES - SET UP THAT BUFFER FIRST
XCRDWC: TRZE F,XSV ;SAVING COMMANDS?
PUSHJ P,XCTWIP ;YES - STOP, AND WIPE OUT THIS ONE
SKIPGE PT,XCTACW ;POINT TO ACTIVE EXECUTE BUFFER - ANY?
JRST XCOERR ;NO - ERROR
MOVE PT,XCTADR(PT) ;YES - GET POINTER
MOVE TY,[POINT 7,PARBUF] ;WRITE TO PARAMETER BUFFER
MOVEI T1,"W" ;START IT OFF
IDPB T1,TY
JRST XCRDL0 ;GO OUTPUT THE BUFFER'S CONTENTS
;HERE TO OUTPUT NAME AND CONTENTS OF ACTIVE BUFFER IN SWITCH FORMAT
XCTRDL: MOVE T1,[260700,,PARBUF]
CAMN T1,PARPTR ;HAS A NAME BEEN GIVEN?
JRST XCRDLC ;NO - READ THE ACTIVE BUFFER
PUSHJ P,XCTFND ;YES - SET UP THAT BUFFER FIRST
XCRDLC: TRZE F,XSV ;SAVING COMMANDS?
PUSHJ P,XCTWIP ;YES - STOP, AND WIPE OUT THIS ONE
SKIPGE T2,XCTACW ;GET NAME OF ACTIVE EXECUTE BUFFER - ANY?
JRST XCOERR ;NO - ERROR
MOVE TY,[POINT 7,PARBUF] ;WRITE TO PARAMETER BUFFER
MOVE T1,[ASCII ?/X:?] ;START IT OFF
PUSHJ P,PUTSQ1
MOVE PT,XCTADR(T2) ;GET POINTER TO BUFFER
MOVE T1,XCTNAM(T2)
TRZ T1,1 ;CLEAR FLAG BIT IN NAME
CAIE T1,0 ;IS NAME NULL
PUSHJ P,PUTSQ1 ;NO - OUTPUT IT
SKIPE T1,XCTKEY(T2) ;GOT A KEY SEQUENCE, TOO?
PUSHJ P,XCTRDK ;YES - OUTPUT IT
MOVEI T1,":" ;SEPARATE NAME AND CONTENTS
IDPB T1,TY
XCRDL0: ILDB T1,PT ;GET A CHARACTER
JUMPE T1,XCREND ;IF NULL FINISH OFF
CAIN T1,"^" ;SPECIAL FLAG?
JRST XCRSPC ;YES - HANDLE SEPARATELY
CAIGE T1," " ;CONTROL CHARACTER?
JRST XCRCTL ;YES - HANDLE SEPARATELY
CAIN T1,"$" ;WANT A REAL DOLLAR SIGN?
JRST [MOVEI T0,"^" ;YES - DISPLAY IT AS UP-ARROW DOLLAR SIGN
IDPB T0,TY
JRST .+1]
XCRDL1: IDPB T1,TY ;YES - OUTPUT IT
XCRDL2: HRRZ T1,TY ;IS THERE ROOM IN THE BUFFER FOR THE CHARACTER?
CAIL T1,PARBUF+PARBLN
JRST XCRENF ;NO - FINISH OFF NOW
JRST XCRDL0 ;AND GET ANOTHER
XCRSPC: HRRZ T1,TY ;IS THERE LIKELY TO BE ROOM IN THE BUFFER?
CAIL T1,PARBUF+PARBLN-1
JRST XCRENF ;NO - FINISH OFF NOW
ILDB T1,PT ;GET CHARACTER AFTER SPECIAL FLAG
CAIN T1,"^" ;WANT A REAL UP-ARROW?
JRST [IDPB T1,TY ;YES - OUTPUT TWO ARROWS TO SHOW IT'S REAL
JRST XCRDL1]
CAIN T1,77 ;RESET COMMAND?
JRST [SETZ T1, ;YES - GET THE RIGHT CODE
JRST XCRCTL]
TRNE T1,100 ;GOT SOME KIND OF CONDITIONAL?
JRST XCRRPT ;YES - HANDLE SEPARATELY
CAIGE T1,40 ;GOT AN EXIT OR CONTINUE, OR OTHER?
JRST XCRCON ;YES - GET STRING FROM CONDITIONAL TABLE
XCRCTL: MOVE T1,CMDNAM(T1) ;GET COMMAND NAME
XCRCT1: PUSHJ P,PUTSQ1 ;OUTPUT IT
JRST XCRDL2 ;BACK TO THE FLOW
XCRCON: MOVE T1,CMDCON(T1) ;GET STRING FROM THE CONDITIONAL TABLE
TRZ T1,177 ;CLEAR OUT FLAGS
CAME T1,[ASCIZ /^OU(/] ;GOT AN OUTPUT COMMAND?
JRST XCRCT1 ;NO - PROCESS IT NORMALLY
PUSHJ P,PUTSQ1 ;YES - OUTPUT IT
MOVEI T2,"^" ;GET AN UP-ARROW FOR SAVING
XCRCN1: ILDB T1,PT ;GET A CHARACTER OF THE OUTPUT STRING
CAIN T1,177 ;END OF STRING?
JRST XCRCNE ;YES - FINISH OFF
CAIE T1,"$" ;GOT A REAL DOLLAR SIGN,
CAIN T1,")" ; OR CLOSE PAREN?
IDPB T2,TY ;YES - PRECEDE WITH AN UP-ARROW
CAIGE T1,40 ;CONTROL CHARACTER?
PUSHJ P,XCRCNC ;YES - OUTPUT SPECIALLY
IDPB T1,TY ;OUTPUT THE CHARACTER
JRST XCRCN1 ;AND GET MORE
XCRCNC: CAIN T1,33 ;ESCAPE?
JRST [MOVEI T1,"$" ;YES - OUTPUT AS A DOLLAR SIGN
POPJ P,]
IDPB T2,TY ;NO - PRECEDE WITH AN UP-ARROW
ADDI T1,100
POPJ P, ;THEN OUTPUT THE CONTROL CHARACTER AND FINISH
XCRCNE: MOVEI T1,")" ;END STRING WITH A CLOSE PAREN
IDPB T1,TY
JRST XCRDL0 ;AND GET MORE OF THE BUFFER
;HERE IF SOME KIND OF CONDITIONAL IS FOUND
XCRRPT: TRNN T1,76 ;ENDING A REPEAT BLOCK?
JRST XCRRPE ;YES - DO SO
TRNE T1,40 ;GOT AN ITERATED DO?
JRST XCRRPD ;YES - HANDLE SPECIALLY
TRNE T1,30 ;GOT AN IF-ROW, -COLUMN, OR -COUNTER?
JRST XCRRPF ;YES - HANDLE SPECIALLY
TRNE T1,4 ;GOT AN IF-CHARACTER?
SKIPA T2,CMDCON+3 ;YES - GET ITS SEQUENCE
MOVE T2,CMDCON+4 ;NO - GET SEQUENCE FOR DO-WHILE
TRZ T2,177 ;CLEAR OUT FLAGS
EXCH T1,T2 ;GET READY TO OUTPUT THE SEQUENCE
TRNE T2,1 ;WANT A "NOT" FLAG?
ORI T1,57260 ;YES - SET "^X" IN SEQUENCE (REALLY)
PUSHJ P,PUTSQ1 ;OUTPUT CONDITIONAL (AND MAYBE THE NOT)
ILDB T1,PT ;GET CHARACTER TO CONDITION ON
CAIN T1,"(" ;IS IT A REAL OPEN PAREN?
JRST [MOVEI T0,"^" ;YES - LEAD IT OFF WITH AN UP-ARROW
IDPB T0,TY
JRST .+1]
IDPB T1,TY ;OUTPUT CONDITION CHARACTER
CAIN T1,"^" ;WANT A CLASS OF CHARACTERS?
JRST [ILDB T1,PT ;YES - GET CLASS
LDB T1,[POINT 7,XCTCLS-1(T1),27]
IDPB T1,TY ;OUTPUT IT
JRST .+1] ;AND CONTINUE
XCRRPX: MOVEI T1,"(" ;START OFF THE REPEAT BLOCK
IDPB T1,TY
JRST XCRDL0 ;AND BACK TO FLOW
XCRRPF: TRNE T1,10 ;GOT AN IF-COLUMN?
SKIPA T2,CMDCON+1 ;YES - GET ITS SEQUENCE
MOVE T2,CMDCON ;NO - GET SEQUENCE FOR IF-ROW
CAIL T1,130 ;OR IS IT REALLY AN IF-COUNTER?
MOVE T2,CMDCON+2 ;YES - GET THE REAL SEQUENCE
TRZ T2,177 ;CLEAR OUT FLAGS
ANDI T1,7 ;ISOLATE CONDITION TYPE
OR T2,XCTREL-2(T1) ;SET UP THE RIGHT CONDITION
MOVE T1,T2
PUSHJ P,PUTSQ1 ;OUTPUT THE CONDITIONAL
ILDB T1,PT ;GET ROW OR COLUMN NUMBER
JRST XCRPD1 ;OUTPUT IT AND FINISH OFF
XCRRPD: MOVEI T2,"^" ;FLAG NUMBER AS A COUNT
IDPB T2,TY
ILDB T2,PT ;GET REPEAT COUNT
DPB T1,[POINT 5,T2,28]
MOVE T1,T2 ;PUT IN HIGH-ORDER BITS
XCRPD1: PUSHJ P,PUTNUM ;OUTPUT IT
JRST XCRRPX ;SAVE CHARACTER AND FLOW
XCRRPE: MOVEI T1,")" ;END THE REPEAT BLOCK
JRST XCRDL1 ;SAVE CHARACTER AND FLOW
XCRENF: TYPCHI 207 ;BEEP TO SHOW ENTIRE BUFFER DIDN'T FIT
XCREND: SETZ T1, ;END WITH A NULL
IDPB T1,TY
MOVEM TY,PARPTR ;SAVE TYPE POINTER AS PARAMETER POINTER
MOVE TY,TYPPTR ;POINT BACK TO TYPE BUFFER
JRST RECAR1 ;PRETEND THIS WAS THE LAST PARAM TYPED
XCTRDK: MOVEI T0,"," ;SUB. TO OUTPUT KEY SEQUENCE
IDPB T0,TY ;OUTPUT THE SEPARATOR
XCTRK1: SETZ T0, ;SHIFT IN A CHARACTER
LSHC T0,7
CAIE T0,177 ;GOT A RUBOUT,
TRNN T0,140 ; OR CONTROL CHARACTER?
JRST [MOVEI T2,"^" ;YES - SIMULATE AS UP-ARROW CHARACTER
IDPB T2,TY ;(RUBOUT IF UP-ARROW "?")
CAIE T0,177
TROA T0,100
MOVEI T0,"?"
JRST .+1]
IDPB T0,TY ;OUTPUT THE CHARACTER
JUMPN T1,XCTRK1 ;LOOP THROUGH THEM ALL
POPJ P, ;THEN DONE
;HERE TO OUTPUT LIST OF DEFINED NAMES
XCTNML: PUSHJ P,SWHBOT ;SET UP THE BOTTOM LINE
MOVE T4,XCTACW ;GET THE POINTER TO THE CURRENTLY-ACTIVE BUFFER
MOVEI T3,"*" ;AND THE INDICATOR FOR CURRENTLY-ACTIVITY
MOVEI T2,XBFNUM-1 ;LOOK FOR NAME OF BUFFER
XCNAM1: SKIPN T1,XCTNAM(T2) ;GET A NAME - ANY?
XCNAM2: SOJGE T2,.-1 ;NO - KEEP LOOKING
JUMPL T2,SWHNPE ;WHEN DONE, FINISH OFF LIKE THE SWITCH INFO
CAMN T4,T2 ;ELSE IS THIS THE ACTIVE BUFFER?
IDPB T3,TY ;YES - MARK IT AS SUCH
TRZ T1,1 ;CLEAR FLAG BIT IN NAME
CAIN T1,0 ;IS THIS THE NULL BUFFER?
MOVE T1,[ASCII /<NUL>/] ;YES - SET UP NULL NAME
PUSHJ P,PUTSQ1 ;OUTPUT NAME
MOVE T1,[ASCII / /] ;SEPARATE NAME FROM NEXT NAME
PUSHJ P,PUTSQ1
JRST XCNAM2 ;GET NEXT NAME
;SUBROUTINE TO READ THE BUFFER NAME AND FIND IT AMONG XCTNAM
;RETURNS NAME IN T4; INDEX IN T1. T1/-1 IF NOT FOUND
XCTRED: MOVE T2,[POINT 7,T4] ;GET POINTERS TO SOURCE, TARGET OF NAME
MOVE PT,[POINT 7,PARBUF,6]
MOVEI T4,1 ;CLEAR TARGET - NAME WILL HAVE LOW BIT ON
MOVEI T3,5 ;READ AT MOST 5 CHARACTERS
XCTRD1: ILDB T1,PT ;GET NEXT CHARACTER
JUMPE T1,XCTRD2 ;DONE IF NULL
CAIL T1,"a" ;LOWER CASE?
SUBI T1,40 ;YES - CONVERT TO UPPER
IDPB T1,T2 ;STORE IT IN TARGET
SOJG T3,XCTRD1 ;GET ANOTHER CHARACTER
XCTRD2: MOVEI T1,XBFNUM-1 ;NOW LOOK FOR NAME
CAME T4,XCTNAM(T1) ;IS THIS IT?
SOJGE T1,.-1 ;NO - LOOP
POPJ P, ;YES (OR NOT FOUND) - RETURN
;HERE TO LINK CURRENT EXECUTE BUFFER TO THE PUSH OF A BUTTON
XCTBTN: TRZE F,XSV ;WAS A BUFFER OPEN?
PUSHJ P,XCTWIP ;YES - CLOSE IT
MOVEI T1,[ASCIZ /Push any command button, then "G": /]
PUSHJ P,PUTBTM ;OUTPUT THE MESSAGE ON BOTTOM LINE
PUSHJ P,PROTOF ;UNPROTECT
PUSHJ P,PUTTYP ;OUTPUT ALL THIS NOW
MOVEI DO,1001 ;NOTE THAT IT'S BUTTON TIME
MOVE PT,XCTACW ;POINT TO ACTIVE EXECUTE BUFFER
PUSHJ P,XCTKLK ;CLEAN OUT OLD KEY, IF ANY
MOVEI T2,200000(PT) ;SET EXECUTE BIT AND SAVE FOR SUBTBX
MOVEM T2,SAVEAC+6
MOVEI PT,XCTKEY(PT) ;MAKE AN ABSOLUTE-ADDRESS POINTER
HRLI PT,440700
MOVEM PT,SAVEAC+5 ;SAVE IT ALSO FOR LATER
IFE TOPS10,<
IFN FTECHO,<
PUSHJ P,EKOALL ;ECHO OFF; BREAK ON EVERYTHING
>>
XCTBT1: GETCHR ;READ A CHARACTER FROM THE TERMINAL IN T1
CAIE T1,"g" ;END OF COMMAND?
CAIN T1,"G"
JRST XCTBT3 ;YES - FINISH OFF
TLNE PT,760000 ;NO - ALREADY GOT 5 CHARACTERS?
IDPB T1,PT ;NO - SAVE CHARACTER
JRST XCTBT1 ;AND GET SOME MORE
XCTBT3:
IFE TOPS10,<
IFN FTECHO,<
PUSHJ P,EKONPT ;ECHO ON; BREAK ON NON-PRINTING CHARACTERS
>>
MOVE T2,SAVEAC+5 ;GET POINTER TO EXECUTE COMMAND SEQUENCE
SKIPE (T2) ;GOT A SEQUENCE?
PUSHJ P,SUBTBX ;YES - IF IT'S LEGAL CHANGE INPUT TABLE
JRST XCTEND ;DONE
;HERE TO READ A FILE OF EXECUTE BUFFER SWITCHES
;CURRENT BUFFERS ARE REPLACED BY THESE
;XCTBW0: SKIPA PT,T2
XCTBSW: TRZE F,XSV ;WAS A BUFFER OPEN?
PUSHJ P,XCTWIP ;YES - CLOSE IT
MOVE PT,[POINT 7,PARBUF,6]
MOVE T3,[POINT 7,SAVEAC+4]
IFN TOPS10,<
MOVEI T4,'XCT' ;GET DEFAULT EXTENSION
>
IFE TOPS10,<
MOVE T4,[ASCII /XCT/]
>
PUSHJ P,PARSFX ;PARSE THE SPECS INTO SCRATCH AREA
HRROI T2,SAVEAC+4 ;FIND THE EXECUTE FILE
PUSHJ P,SETINP
JUMPE T1,XCIERR ;ERROR IF FILE NOT FOUND
XCTSB0: PUSHJ P,PIKFRG ;MAKE SURE PICK BUFFER IS NOT FRAGGED
IFN TOPS10,<
MOVEI T1,-400 ;SET TO READ 400 WORDS
HRLM T1,SEDCCL
INPUT 5,SEDCCL ;READ FILE INTO PICK BUFFER
RELEAS 5,
>
IFE TOPS10,<
MOVE T2,[POINT 7,PIKBUF+PCBSIZ-400]
SETZ T3, ;READ THE FILE
SIN
CLOSF ;CLOSE IT
HALTF
>
MOVEI PT,XBFNUM-2 ;ZERO ALL EXISTING INFO, EXCEPT DEFAULT BFR
PUSHJ P,XCTKLL
SOJGE PT,.-1
PUSHJ P,XCGARB ;GARBAGE COLLECT (MOVE DEF BFR STUFF TO TOP)
MOVEM T4,XCFPTR ;SAVE POINTER TO FIRST FREE WORD OF BUFFER
MOVE PT,[POINT 7,PIKBUF+PCBSIZ-400]
XCTSB1: ILDB T1,PT ;GET 1ST CHARACTER OF FILE
JUMPE T1,XWFERR ;END - ERROR - WRONG FORMAT
CAIE T1,"/" ;IS IT A SWITCH?
JRST XCTSB1 ;NO - LOOP UNTIL START OF SWITCHES
XCTSB2: PUSHJ P,SWHMNY ;GO PARSE THE SWITCHES
ILDB T1,PT ;GET CHARACTER OF NEXT LINE
CAIN T1,"/" ;ANOTHER SWITCH?
JRST XCTSB2 ;YES - SET IT UP, TOO
MOVEI T1,XBFNUM-1 ;NO - MAKE LAST (NULL) EXECUTE BUFFER ACTIVE
MOVEM T1,XCTACW
TLZN F,FLG ;CALLED BY SWHMNX?
JRST XCTEND ;NO - FINISH OFF
POPJ P, ;YES - RETURN TO IT
;EXECUTE, NO PARAMETER: IF BUFFER IS OPEN, JUST CLOSE IT
;IF ALREADY CLOSED, SET TO DO SAME NUMBER OF ITERATIONS AS LAST TIME
EXCNPM::TRZN F,XSV ;SAVING COMMANDS?
JRST EXCNP1 ;NO - SET UP FOR ITERATING
MOVE PT,XCTPTW ;YES - GET POINTER TO END OF BUFFER
PUSHJ P,XCTCLO ;CLOSE OFF THE BUFFER
JRST LOOP ;AND GET A NEW COMMAND
EXCNP1: MOVE T3,XCTITR ;GET NUMBER OF ITERATIONS
SKIPLE T4,T3 ;ANY?
JRST EXCUT1 ;YES - GO SET IT UP
MOVEI T1,[ASCIZ /####Enter number of iterations/]
JRST ERROR
;GET A COMMAND FROM THE EXECUTE BUFFER, FROM LOOP
XCTGET::
IFN FTJOUR,<
TLNE TM,JRC ;IS THIS A JOURNAL RESTORE?
JRST LOPJRN ;YES - GET THE CHARACTER FROM THE JOURNAL
>
ILDB T1,XCTPTR ;GET A COMMAND FROM READ BUFFER
CAIN T1,"^" ;SPECIAL CHARACTER FLAG?
JRST XCTGT1 ;YES - HANDLE SPECIALLY
JUMPN T1,XCTGTE ;IF GOT A REAL CHARACTER, USE IT
XCTGT0: MOVE T1,XCTACR ;ELSE POINT BACK TO START OF BUFFER
MOVEM T1,XCTPTR
SOSG T2,XCTNUM ;ELSE WANT TO DO ANOTHER ITERATION?
JRST XCTDUN ;NO - FINISH OFF OR POP A LEVEL
PUSHJ P,XCTWIS ;YES - MAY WANT TO WHISTLE
JRST XCTGET ;GO GET FIRST COMMAND
XCTWIS: TRNN F,XBN ;DISPLAYING THE EXECUTE,
TRNE T2,7 ; OR DON'T WANT TO WHISTLE?
JRST XCTSTP ;EITHER - DON'T WHISTLE
TYPCHI 207 ;NEITHER - WHISTLE
XCTSTP: PUSHJ P,SRCIPT ;DOES THE USER WANT TO ABORT THE EXECUTE?
JRST XABERR ;YES - DO SO
POPJ P, ;NO - PROCEED
XCTGTE::CAIGE T1," " ;SOME CONTROL CHARACTER?
JRST LOOP2 ;YES - HANDLE IT
XCTGE1:
IFE TOPS10,<
IFN FTECHO,<
TDNE F,[CCH!ENT,,XCT!IMD] ;NO - ENTERING, EXECUTING, GOT ECC, IMD?
JRST ALPNUM ;YES - JUMP WITHOUT ECHOING
TLNN TM,XCI ;NO - INITIALIZING FOR AN EXECUTE?
TYPCHA ;NO - ECHO THE REAL CHARACTER
>>
JRST ALPNUM ;NO - JUST PUT IT IN FILE OR BUFFER
XCTGT1: ILDB T1,XCTPTR ;GET CHARACTER AFTER THE UP-ARROW
CAIN T1,"^" ;WANT A REAL UP-ARROW?
JRST XCTGE1 ;YES - TREAT IT LIKE A NORMAL CHARACTER
CAIN T1,77 ;GOT A RESET COMMAND?
JRST [SETZ T1, ;YES - GET THE REAL CODE AND DISPATCH
JRST LOOP2]
CAIGE T1,40 ;GOT AN EXIT OR CONTINUE, OR SOMETHING?
JRST XCTGCT ;YES - GO HANDLE IT
TRNN T1,100 ;GOT THE START OR END OF A REPEAT?
JRST LOOP2 ;NO - PROCESS THE COMMAND
TRNN T1,76 ;END OF A REPEAT?
JRST XCTGRX ;YES - GO HANDLE IT
;HERE IF SOME KIND OF CONDITIONAL
TRNE T1,40 ;GOT AN ITERATED DO?
JRST XCGITR ;YES
TRNE T1,30 ;GOT AN IF-ROW, -COLUMN OR -COUNTER?
JRST XCGTRC ;YES
PUSHJ P,MAKCPT ;NO - RE-MAKE CHARACTER POINTER
ILDB T2,XCTPTR ;GET CHARACTER OR CLASS TO CHECK FOR
CAIN T2,"^" ;GOT A CLASS?
TRO T1,200000 ;YES - SET CLASS FLAG
PUSHJ P,XCTCHK ;SEE IF CONDITION IS TRUE
TRNE T1,4 ;GOT AN IF-CHARACTER?
JRST XCGTIF ;YES
;HERE FOR DO-WHILE
JUMPN T0,XCTSKB ;IF FALSE SKIP THE BLOCK
HRL T2,T1 ;ELSE SET UP FLAGS,,CHAR
TLO T2,400000 ;SET DO-WHILE FLAG
JRST XCGIT1 ;SAVE STUFF AND DO THE BLOCK
;HERE FOR ITERATED DO
XCGITR: ILDB T2,XCTPTR ;GET LOW BITS OF REPEAT COUNT
DPB T1,[POINT 5,T2,28] ;PUT HIGH-ORDER BITS IN, TOO
XCGIT1: JUMPE T2,XCTSKB ;IF ZERO ITERATIONS, JUST SKIP THE BLOCK
AOS T1,XCTLVL ;DROP DOWN A LEVEL OF NESTING
CAIN T1,1 ;NOW AT LEVEL ONE?
JRST XCGIT2 ;YES - DON'T SAVE
PUSH P,XCTRPR ;SAVE PTR TO START OF BLOCK
PUSH P,XCTRPT ;SAVE PREVIOUS REPEAT COUNT
XCGIT2: MOVEM T2,XCTRPT ;SAVE COUNT AND FLAGS
MOVE T1,XCTPTR ;SAVE POINTER TO START OF BLOCK
MOVEM T1,XCTRPR
JRST XCTGET ;PICK UP THE FIRST ITERATION
;HERE FOR IF-ROW, IF-COLUMN, IF-COUNTER, AND IF-CHARACTER (XCGTIF)
XCGTRC: TRNN T1,10 ;GOT AN IF-COLUMN?
SKIPA T3,RW ;NO - GET ROW FOR COMPARISON
MOVE T3,CM ;YES - GET COLUMN FOR COMPARISON
ILDB T2,XCTPTR ;GET VALUE TO COMPARE WITH
CAIL T1,130 ;IS IT REALLY AN IF-COUNTER?
SKIPA T3,XCTCTR ;YES - GET THE COUNTER (DON'T DEC VALUE)
SOJ T2, ;IT'S ONE TOO HIGH, SINCE RW & CM ZERO-BASED
TRNE T1,4 ;WANT EQUALITY?
JRST [CAME T3,T2 ;YES - ARE THEY EQUAL?
JRST XCGRCF ;NO - SET UP FALSE
JRST XCGRCT] ;YES - SET UP TRUE
CAMN T3,T2 ;DON'T WANT EQUALITY - ARE THEY EQUAL?
JRST XCTSKB ;YES - IT MUST BE FALSE
CAML T3,T2 ;NO - IS PARAMETER GREATER THAN VALUE?
XCGRCT: TDZA T0,T0 ;YES - SET UP TRUE
XCGRCF: SETO T0, ;NO - SET UP FALSE
TRNE T1,1 ;WANT TO NEGATE THE RESULT?
SETCM T0,T0 ;YES
XCGTIF: JUMPE T0,XCTGET ;IF TRUE, KEEP GOING
XCTSKB: PUSHJ P,XCTSKP ;ELSE SKIP OVER THE BLOCK
JUMPE T1,XCTGT0 ;JUMP IF END OF BUFFER
JRST XCTGET ;AND GET WHAT COMES AFTERWARDS
;HERE TO SKIP TO END OF A BLOCK AND GET WHAT FOLLOWS
XCTSKP: SETZ T0, ;CLEAR COUNT OF BLOCKS PASSED OVER
XCTSK1: ILDB T1,XCTPTR ;SKIP OVER NEGATIVE "IF" BLOCK
JUMPE T1,CPOPJ ;DONE IF END OF BUFFER
CAIE T1,"^" ;START OR END OF A BLOCK?
JRST XCTSK1 ;NO - KEEP SKIPPING
ILDB T1,XCTPTR ;YES - GET FOLLOWING CHARACTER
TRNE T1,76 ;END OF A BLOCK?
JRST XCTSK2 ;NO - MAYBE DROP A LITTLE DEEPER
SOJGE T0,XCTSK1 ;YES - LOOP OF NOT THE RIGHT END
POPJ P, ;ELSE DONE
XCTSK2: TRNE T1,100 ;IS THIS A COMMAND,
CAIN T1,"^" ; OR WANT A REAL UP-ARROW?
JRST XCTSK1 ;EITHER - SKIP OVER IT
AOJA T0,XCTSK1 ;ELSE DROP A LEVEL AND KEEP SKIPPING
;HERE FOR AN EXIT OR CONTINUE CONSTRUCT
XCTGCT: CAILE T1,7 ;GOT AN EXIT OR CONTINUE?
JRST @XCTJMP-10(T1) ;NO - DISPATCH TO HANDLE IT
CAIN T1,7 ;WANT TO END THIS ITERATION (^XX)?
JRST XCTGTX ;YES - POP STACK AND DO SO
MOVE T2,T1 ;NO - SAVE TYPE OF CONSTRUCT
ILDB T0,XCTPTR ;GET THE ")" THAT FOLLOWS THE COMMAND
PUSHJ P,XCTSKP ;SKIP TO END OF THE BLOCK
JUMPE T1,XCTGT0 ;JUMP IF END OF BUFFER
CAIE T1,100 ;IS THIS AN IF CONSTRUCT?
JRST XCTGET ;YES - GO EXECUTE FROM HERE
CAIE T2,6 ;NO - WANT TO EXIT THE BLOCK (^XB)?
JRST XCTGXP ;YES - DO SO
;ELSE FALL TO CONTINUE THE BLOCK
;HERE IF END OF A BLOCK - IGNORE IF ^A (IF); LOOP OR EXIT IF ^@ (^DO)
XCTGRX: CAIE T1,100 ;END OF DO BLOCK?
JRST XCTGET ;NO - IGNORE IT
TLZE TM,XCI ;STOP INITIALIZING?
JRST XCTGXI ;YES - JUST DE-BUMP LEVEL
PUSHJ P,XCTSTP ;SEE IF USER WANTS TO STOP
SKIPGE XCTRPT ;GOT A DO-WHILE?
JRST XCTGXW ;YES - CHECK CHARACTER AT CURSOR
SOSG XCTRPT ;NO - DO-ITR - DE-BUMP COUNTER - DONE?
JRST XCTGXP ;YES - POP BACK A LEVEL
XCTGXR: MOVE T1,XCTRPR ;NO - GET POINTER TO START OF BLOCK
MOVEM T1,XCTPTR ;SAVE IT AS REAL POINTER
JRST XCTGET ;AND TAKE COMMANDS FROM THERE
XCTGXW: PUSHJ P,MAKCPT ;RE-MAKE CHARACTER POINTER
HLRZ T1,XCTRPT ;GET FLAGS
HRRZ T2,XCTRPT ;GET CHARACTER OR CLASS TO CHECK FOR
TRNE T1,200000 ;GOT A CLASS?
JRST [SETZ T0, ;YES - GO CHECK THE CONDITION
PUSHJ P,XCTCHC+1
JRST XCGXW1]
PUSHJ P,XCTCHK ;NO - CHECK THE CONDITION
XCGXW1: JUMPE T0,XCTGXR ;IF TRUE JUST DO THE BLOCK, ELSE POP LEVEL
XCTGXP: SKIPE XCTLVL ;SKIP IF STACK IS CLEAR
SOSG XCTLVL ;AT BOTTOM LEVEL?
JRST XCTGET ;YES - JUST KEEP GOING
POP P,XCTRPT ;ELSE GET SAVED COUNT (OR COMPARATOR)
POP P,XCTRPR ;AND INITIAL REPEAT POINTER
JRST XCTGET ;AND TAKE COMMANDS FROM THERE
XCTGTX: SKIPE XCTLVL ;SKIP IF STACK IS CLEAR
XCGTX1: SOSG XCTLVL ;POP EVERYTHING OFF THE STACK - ANY LEFT?
JRST XCTGT0 ;NO - DO ANOTHER ITERATION
POP P,XCTRPT ;YES - POP IT OFF ALREADY
POP P,XCTRPR
JRST XCGTX1 ;AND TRY AGAIN
XCTGXI: SETZM XCTLVL ;END OF XCT INIT - CLEAR LEVEL
MOVE T1,XCTPTR ;GET POINTER TO CURRENT POSITION
EXCH T1,XCTACR ;SAVE AS STARTING POINTER
MOVEM T1,XCTINI ;SAVE REAL STARTING POINTER, TOO
JRST XCTGET ;READ MORE OF BUFFER
;DISPATCH FOR ROUTINES TO HANDLE SPECIAL EXECUTE CONSTRUCTS
XCTJMP: XCTG10 ;(10) ITERATE-COUNTER
XCTG11 ;(11) CLEAR-COUNTER
XCTG12 ;(12) BUMP-COUNTER
XCTG13 ;(13) DE-BUMP-COUNTER
XCTG14 ;(14) USE-COUNTER
XCTG15 ;(15) INITIALIZE
XCTG16 ;(16) OUTPUT
XCTG17 ;(17) SAVE-COUNTER
XCTG20 ;(20) NO-DISPLAY
XCTG21 ;(21) DO-ON-SEARCH-ERROR
XCTG21: PUSHJ P,XCTSKP ;NOT A SEARCH ERROR, SO JUST SKIP THE BLOCK
JRST XCTGET ;DONE
XCTG20: TRZE F,XBN ;TURN OFF BUTTON FLAG - ON?
TRO F,XCT ;YES - TURN ON NORMAL EXECUTE FLAG
JRST XCTGET ;DONE
XCTG17: TLZN F,ENT ;IS THERE A PARAMETER?
JRST XCG17A ;NO - USE OLD NOMINAL
MOVEI DO,$SETCT ;NOTE THAT THIS IS A SET-COUNTER CONSTRUCT
MOVE T4,XCTSNM ;GET LAST TIME'S NOMINAL
MOVEM T4,PARG1
PUSHJ P,PEEL.1 ;READ NEW PARM, IF ANY
TRNE F,CMV ;CURSOR MOVEMENT?
SKIPA T4,PARG2 ;YES - GET CHANGE IN COLUMNS
MOVE T4,PARG1
MOVEM T4,XCTSNM ;SAVE AS NEW NOMINAL
XCG17A: MOVE T4,XCTSNM ;GET COUNTER SETTING
MOVEM T4,XCTCTR ;SAVE AS COUNTER VALUE
JRST XCTGET ;DONE
XCTG16: ILDB T1,XCTPTR ;GET A CHARACTER TO OUTPUT
CAIN T1,177 ;END OF STRING?
JRST XCG16A ;YES - OUTPUT IT AND FINISH OFF
IDPB T1,TY ;NO - SAVE THE CHARACTER
JRST XCTG16 ;AND GET ANOTHER
XCG16A: PUSHJ P,PUTTYP ;OUTPUT THE STRING
JRST XCTGET ;AND READ MORE OF THE BUFFER
XCTG15: TLO TM,XCI ;INITIALIZE - SET FLAG
AOS XCTLVL ;DROP DOWN A LEVEL
JRST XCTGET ;READ MORE OF BUFFER
XCTG14: SKIPGE T1,XCTCTR ;GET COUNTER - IS IT NEGATIVE?
SETZ T1, ;YES - SET TO ZERO
EXCH TY,PARPTR ;SAVE OUTPUT POINTER AND GET PARAMETER POINTER
PUSHJ P,PUTNUM ;OUTPUT NUMBER TO PARAMETER BUFFER
EXCH TY,PARPTR ;SWAP PARAMETER AND OUTPUT POINTERS BACK
JRST XCTGET ;READ MORE OF BUFFER
XCTG13: SOSA XCTCTR ;DE-BUMP COUNTER
XCTG12: AOS XCTCTR ;I MEAN BUMP IT
JRST XCTGET ;GET A NEW COMMAND
XCTG11: SETZM XCTCTR ;CLEAR THE COUNTER
JRST XCTGET
XCTG10: SKIPGE T2,XCTCTR ;GET COUNTER - NEGATIVE?
SETZ T2, ;YES - USE 0
JRST XCGIT1 ;USE IT WITH AN ITERATED DO
REPEAT 0,<
;SUBROUTINE TO .OR. A NUMBER OF CHARACTERS OR CONDITIONS FOR ^DW OR ^IF
XCTCKI: SETZM SAVEAC+1 ;CLEAR THE OVERALL CONDITION FLAG
XCTCI1: ILDB T2,XCTPTR ;GET A CHARACTER OR CLASS TO CHECK FOR
PUSHJ P,XCTCHK ;CHECK IT OUT
JUMPG T0,XCTCI2 ;DONE IF END OF BLOCK
ORM T0,SAVEAC+1 ;OR THIS CONDITION WITH THE OTHERS
JRST XCTCI1 ;AND CHECK THE NEXT CONDITION
XCTCI2: MOVE T0,SAVEAC+1 ;GET THE CONDITION FLAG
POPJ P, ;DONE
;HERE FOR THE START OR END OF A LIST OF CONDITIONALS
XCTCIE: CAIN T2,20 ;START OF A LIST OF CONDITIONS?
JRST XCTCHI ;YES
MOVEI T0,1 ;RETURN A POSITIVE VALUE
POPJ P, ;DONE
>
;SUBROUTINE TO CHECK TO SEE IF CHARACTER IN T3 MATCHES CHAR OR CLASS IN T2
XCTCHK: CAIN T2,"^" ;WANT A CLASS?
JRST XCTCHC ;YES - HANDLE SEPARATELY
CAMN T3,T2 ;NO - GOT THE RIGHT CHARACTER?
XCTCHT: TDZA T0,T0 ;YES - FLAG AS TRUE
XCTCHF: SETO T0, ;NO - FLAG AS FALSE
TRNE T1,1 ;GOT .NOT. FLAG?
SETCM T0,T0 ;YES - RETURN THE OPPOSITE RESULT
POPJ P, ;DONE
XCTCHP: MOVE T1,SAVEAC ;RESTORE SAVED T1
POPJ P, ;DONE
XCTCHC: ILDB T2,XCTPTR ;GET CLASS TO CHECK FOR
REPEAT 0,<
CAIL T2,20 ;START OR END OF A CONDITION LIST?
JRST XCTCIE ;YES
>
CAIN T2,2 ;END OF LINE?
JRST XCTCHE ;YES
CAIN T2,3 ;NUMBER?
JRST XCTCHN ;YES
CAIN T2,5 ;SPACE?
JRST XCTCHS ;YES
CAIGE T3,"A" ;CHECK FOR UPPER, LETTER OR ALPHA-NUM
JRST XCTCHM ;NOT LETTER - MAY BE NUMBER
CAIG T3,"Z" ;LETTER?
JRST XCTCHT ;YES - RETURN TRUE
CAIN T2,6 ;LOOKING FOR UPPER CASE?
JRST XCTCHF ;YES - RETURN FALSE
CAIL T3,"a" ;NO - IS IT LOWER CASE?
CAILE T3,"z"
JRST XCTCHF ;NO - RETURN FALSE
JRST XCTCHT ;ELSE TRUE
XCTCHM: CAIE T2,4 ;NOT ALPHA - WANT ALPHA-NUM?
JRST XCTCHF ;NO - RETURN FALSE
XCTCHN: CAIL T3,"0" ;CHECK FOR NUMBER - IS IT?
CAILE T3,"9"
JRST XCTCHF ;NO - RETURN FALSE
JRST XCTCHT ;ELSE RETURN TRUE
XCTCHS: TRNN T1,1 ;CHECKING FOR A CHARACTER?
JRST XCCHSS ;NO - CHECK FOR SPACE
CAIN T3,15 ;YES - END OF LINE?
JRST XCTCHT ;YES - RETURN TRUE (NEGATED)
CAIE T3," " ;NO - SPACE OR TAB?
CAIN T3,11
JRST XCTCHT ;YES - RETURN TRUE (NEGATED)
JRST XCTCHF ;ELSE RETURN FALSE
XCCHSS: CAIN T3," " ;SPACE?
JRST XCCHS0 ;YES - MAKE SURE IT'S NOT TRAILING
CAIE T3,11 ;TAB?
JRST XCTCHF ;NO - RETURN FALSE
XCCHS0: MOVEM T1,SAVEAC ;SAVE T1
PUSH P,[XCTCHP] ;SAVE RESTORE-T1 ADDRESS
TRO T1,1 ;LOOK FOR NON-END OF LINE
XCTCHE: MOVE T4,CHRPTR ;GET CURSOR POINTER
XCCHE0: CAIN T3,15 ;AT END OF LINE?
JRST XCTCHT ;YES - RETURN TRUE
CAIN T3," " ;NO - GOT A (MAYBE TRAILING) SPACE?
JRST XCCHE1 ;YES - SKIP IT
CAIE T3,11 ;HOW ABOUT A (MAYBE TRAILING) TAB?
JRST XCTCHF ;NO - RETURN FALSE
XCCHE1: ILDB T3,T4 ;YES - GET NEXT CHARACTER
JUMPE T3,.-1 ;IGNORE NULLS
JRST XCCHE0 ;GO CHECK THE REAL CHARACTER
;HERE AT END OF EXECUTE BUFFER - FINISH OFF OR POP UP A LEVEL
XCTDUN: SKIPN T1,XCTPSV ;GOT A SAVED POINTER?
JRST XCTDN1 ;NO - REALLY DONE
SETZ T1, ;YES - GET READY TO ZERO THINGS
EXCH T1,XCTPSV ;GET AND ZERO SAVED POINTER
MOVEM T1,XCTPTR ;MAKE IT ACTIVE AGAIN
MOVE T1,XCTASV ;GET SAVED STARTING POINTER
MOVEM T1,XCTACR ;SET IT UP
MOVE T1,XCTISV ;GET NOMINAL SAVED ITERATIONS
MOVEM T1,XCTITR ;SET THEM UP, TOO
MOVE T1,XCTNSV ;GET SAVED ITERATIONS
MOVEM T1,XCTNUM ;SET THEM UP, TOO
JRST XCTGET ;AND CONTINUE WITH THEM
XCTDN1: TRNE F,XBN ;DID USER PUSH A SPECIAL BUTTON?
TLO F,FLG ;YES - REMEMBER IT
EXCH T1,XCTASV ;GET AND ZERO SAVED STARTING POINTER
JUMPE T1,XCTDN2 ;IS THERE ONE?
MOVEI T2,XBFNUM-1 ;YES - FIND ITS INDEX
CAME T1,XCTADR(T2) ;IS THIS IT?
SOJGE T2,.-1 ;NO - TRY NEXT ONE
MOVEM T2,XCTACW ;SAVE INDEX AS THE ACTUAL ACTIVE BUFFER
XCTDN2: MOVE TY,TYPPTR
MOVS T1,[PARAMS,,SAVPRM]
BLT T1,PARAMS+SAVPML-1 ;RESTORE ALL PARAMETERS
HRRZ T1,SAVFGS ;RESTORE PREVIOUS F SWITCH FLAGS
TRZ F,SWFLGS
ANDI T1,SWFLGS
OR F,T1
HLLZ T1,SAVFGS ;RESTORE PREVIOUS TM SWITCH FLAGS
TLZ TM,BEP!LSD!JRC
AND T1,[BEP!LSD!JRC,,0]
OR TM,T1
SKIPE T1,XCTINI ;IS THERE AN INITIAL POINTER?
MOVEM T1,XCTACR ;YES - SET IT UP AS STARTING POINTER
SETZM XCTINI ;CLEAR INITIAL POINTER
MOVEI T1,1
TRNE F,RST ;WANT TO RESTORE THE NOMINAL PARAMETER?
MOVEM T1,XCTITR ;YES - SET IT BACK TO 1
TLZ F,ENT ;DON'T ALLOW THE USER TO LEAVE ENTER IN EFFECT
TLZE F,FLG ;DID USER PUSH A SPECIAL BUTTON?
JRST LOOP ;YES - SCREEN IS ALREADY O.K.
JRST DISALL ;NO - RE-DISPLAY SCREEN AND LOOP
;EXECUTE ERROR MESSAGES
XSXERR: MOVEI T1,[ASCIZ /####Execute stacked too deeply/]
SETZM XCTPSV
JRST ERROR
XSCERR: SKIPA T1,[[ASCIZ /Counter must have a numeric parameter/]]
XWFERR: MOVEI T1,[ASCIZ /####Bad format for execute file/]
JRST ERROR
XCIERR:
IFN TOPS10,<
MOVSI T1,'TED' ;TRY FOR FILE ON THE TEXT EDITOR DEVICE
MOVEM T1,GENBLK+1
PUSHJ P,SETINP ;SEE IF IT'S THERE
JUMPN T1,XCTSB0 ;IF THERE, USE IT
>
MOVEI T1,[ASCIZ /#######Execute file not found/]
JRST ERROR
XCXERR: MOVEI T1,[ASCIZ /######Current buffer is empty/]
JRST ERROR
XCOERR: MOVEI T1,[ASCIZ /########No buffer is active/]
JRST ERROR
XCSERR: MOVEI T1,[ASCIZ /#No free buffers - kill something/]
JRST ERROR
XCNERR: MOVEI T1,[ASCIZ /##No execute buffer by that name/]
JRST ERROR
XCEERR::MOVEI T1,[ASCIZ /####Start or end of file reached/]
SKIPA TY,TYPPTR
XCKERR: MOVEI T1,[ASCIZ /####Can't kill - name not found/]
JRST ERROR
XABERR: MOVEI T1,[ASCIZ /#########Execution stopped/]
JRST ERROR
XCTERR::MOVE PT,XCTPTW ;GET POINTER TO BUFFER CONTENTS
PUSHJ P,XCTCLO ;CLOSE OFF THE BUFFER
TRZ F,XSV ;STOP SAVING
MOVEI T1,[ASCIZ /Execute buffer is about to overflow/]
JRST ERROR
XCVERR: MOVE T1,XCTACW ;CLEAR OVERFLOWED BUFFER
MOVE T1,XCTADR(T1)
SETZM @1(T1)
MOVEI T1,[ASCIZ /#####Execute buffer overflowed/]
JRST ERROR
END
Reference in New Issue View Git Blame Copy Permalink