. . SCANNING ROUTINES . . . (C) Copyright 1972-1978 John Walker . . This software is in the public domain . AXR$ DEFUNCT$ FANG . . CHARACTER CLASS NAMES . ERR EQU 0 BAD CHARACTER AN EQU 1 ALPHANUMERIC DELIM EQU 2 DELIMITER . . DEFAULTS FOR JCL INSTRUCTION . CL$UNDF(0) EQU BADDELIM PURE CODE . . PROCESS A COMMAND LINE . CMDSCAN* IALL$ SHIGGY,BIT(011),1 SET ACTIVITY CONTINGENCY CMDGET LA A0,LINENO LOAD LINE NUMBER AA,U A0,1 INCREMENT IT SA A0,LINENO UPDATE CURRENT LINE NUMBER P CONCUR INVOKE CONCURRENCY LOCK . . READ IN A LINE . TZ EOFHIT WAS END OF FILE ENCOUNTERED ? J WINDDOWN YES. SKIP THE READ ON DEBUG TZ PRINTYET HAS LAST IMAGE BEEN PRINTED ? J SCNPBG YES. NO BUG THIS TIME LMJ X5,PRINT PRINT THE FATAL IMAGE IERR . LAST IMAGE WAS NOT PRINTED BY SCANNER SCNPBG . OFF DEBUG LA,U A0,13 GET WORD COUNT SNONZ CRDBUF,A0 CLEAR A WORD JGD A0,$-1 LOOP FOR ALL OF THEM SZ FROMADD CLEAR COMMAND FROM ADD FILE FLAG JNDEM BATIN DEMAND ? F$DT1 2,line NO. SET UP FOR SOLICITATION F$DECF 3,LINENO EDIT LINE NUMBER F$CHAR '.' EDIT DOT F$SKIP 1 SPACE BEFORE INPUT ON EOL>-1 F$CHAR EOL TERMINATE THE LINE OFF EOL>-1 TREAD TRDEPK READ A COMMAND SNONZ PRINTYET SET IMAGE PRINTED ALREADY FOR DEMAND TEP A0,(BIT(34)) WAS COMMAND FROM AN ADD FILE ? SNONZ FROMADD YES. DON'T PLAY INTERACTIVE GAMES J STARTSCAN GO SCAN IT OFF . . BATCH INPUT HANDLER . BATIN READ$ CRDBUF,WINDDOWN READ A LINE TEP A0,(BIT(34)) WAS COMMAND FROM AN ADD FILE ? SNONZ FROMADD YES. SET FOR LATER ERROR CHECKS SZ PRINTYET MARK CARD NOT YET PRINTED . . START COMMAND SCAN HERE . STARTSCAN SZ SHADUP CLEAR OUTPUT SUPPRESSION FLAG E$DITR SCNPKT SET UP EDITOR ON CRDBUF E$COL 0 SET TO COLUMN 1 LR,U R4,12 GET COUNTER FOR COMMAND LENGTH SCAN COMMAND,2 SET UP TO STORE INTO COMMAND U$POS4 . IGNORE LEADING BLANKS JE A0,'.',COMMENT DON'T SCAN FURTHER IF IT'S A COMMENT JP A0,ACUMCM PROCESS IF NONBLANK JDEM DECRT REISSUE NUMBER IF DEMAND J COMMENT OTHERWISE, TREAT AS A COMMENT . ACUMCM JE A0,' ',ENDCMD BLANK TERMINATOR ? JE A0,',',ENDCMD START OF OPTIONS FIELD ? JA A0,CMAC1 ACCEPT ALPHABETICS ONLY JNUM A0,CMAC1 BUT ALLOW NUMERICS TO PASS FOR NOW J BADDELIM FLAG BAD DELIMITER CMAC1 JGD R4,$+2 PART OF COMMAND. OVER 12 CHARACTERS ? J INSTIX YES. IGNORE THIS CHARACTER STCHR . STORE A CHARACTER INTO THE COMMAND FIELD INSTIX U$CHAR . SCAN THE NEXT CHARACTER J ACUMCM INTERPRET THIS CHARACTER . ENDCMD DL A0,COMMAND LOAD THE COMMAND LX X7,(CMDEL,0) GET SEARCH POINTER LR,U R1,CMDTLEN LOAD LENGTH OF COMMAND TABLE ENDSE SE A0,CMDTAB,*X7 LOOK FOR COMMAND J BADCMD ALL OUT. UNKNOWN COMMAND TE A1,CMDTAB-CMDEL+1,X7 IS SECOND WORD RIGHT ? J ENDSE NO. KEEP ON LOOKIN' . FOUND THE COMMAND IN THE TABLE FNABB ANX,U X7,CMDEL MAKE X7 THE TABLE INDEX LA A0,LINENO LOAD LINE NUMBER COMMAND FOUND ON SA A0,SASLN SAVE FOR IMAGE BUFFER USE LATER LA,U A1 CLEAR OPTIONS TO START LA A0,CMDTAB+CTMODE,X7 LOAD MODE BITS TEP,U A0,IU IMPLY 'U' OPTION ? AA,U A1,OPTION('U') YES. SET 'U' OPTION SA A1,CWOPTION SET INITIAL (IMPLIED) OPTIONS E$SKIP -1 BACK UP TO LOOK AT DELIMITER U$CHAR . GET DELIMITER JNE A0,',',ENDOPT NEED WE SCAN OPTIONS ? OPTGET U$CHAR . YES. GET AN OPTION LETTER JE A0,' ',ENDOPT END OF OPTIONS ? JNA A0,BADOPT ...OR BAD OPTION ? LA A1,(OPTION('A')) GOOD OPTION. GET 'A' CODE ANA,U A0,'A' CONVERT TO SHIFT COUNT SSL A1,,A0 SHIFT BIT INTO POSITION OR A1,CWOPTION OR WITH OPTIONS SO FAR SA A2,CWOPTION UPDATE CUMULATIVE OPTIONS J OPTGET KEEP SCANNING OPTIONS . ENDOPT . SZ CWREPEAT CLEAR REPEAT FLAG TP CMDTAB+CTPN,X7 IS IT A REPEAT MODE COMMAND ? SNONZ CWREPEAT YES. SET IT UP THAT WAY LA A0,CTPN+CMDTAB,X7 LOAD NUMBER OF PARAMETERS SA A0,CWPARS SAVE NUMBER TO SCAN LX X8,CMDTAB+CTPTP,X7 POINT TO PARAMETER TABLE LA,U A15 CLEAR PARAMETER COUNTER TNZ CMDTAB+CTPN,X7 ZERO PARAMETERS REQUIRED ? J DOCOMMAND RIGHT. SKIP SCANNING PROCESS . . THIS LOOP SCANS THE PARAMETERS . GETNP U$POS3 . ADVANCE TO NEXT NON-BLANK JP A0,PARPRES IS PARAMETER PRESENT ? . NO. INVESTIGATE THE CONSEQUENCES NOMORE TNE A15,CWPARS ALL PARAMETERS SCANNED ? J DOCOMMAND YES. INTERPRET THE COMMAND NOW TZ CWREPEAT SPECIAL CASE FOR REPEAT ? J DORPT YES. CHECK THAT LA A0,PDTYPE,X8 LOAD PARAMETER TYPE TE,U A0,KEY IT IS A KEY ? TNE,U A0,DATA IS IT DATA ? J PARPRES YES. IT'S A TRAILING PARAMETER TNE,U A0,CURBLK WAS TYPE 'CURRENT BLOCK' ? J SCNIBL YES. SET UP FOR INTERNAL SCAN TNE,U A0,EITHER IS IT PROGRAM FILE ELEMENT CLASS ? J SCNTPF YES. GO PICK UP TPF$ ASSUMED SPECIFICAT TNZ PDOMIT,X8 NO. MAY PARAMETER BE LEFT OFF J OMPERR ERROR. ILLEGALLY OMITTED PARAMETER TNE,U A0,BLOCK OMITTED BLOCK-TYPE PARAMETER ? J SCNIBL YES. USE CURRENT BLOCK INSTEAD . WE HANDLE AN OMITTED PARAMETER BY SETTING THE 'NO PARAMETER SCANNED' . INDICATOR AND PASSING CONTROL TO THE END OF PARAMETER ROUTINE. . THIS ALLOWS US TO PICK UP DATA, AND IMPLIED PARAMETERS THAT . ARE SCANNED EVEN IF NOTHING REMAINS ON THE CURRENT COMMAND . IMAGE. SNONZ ZIMPLE SET NO SCANNING ACTUALLY DONE J SCNNOPE ENTER COMPLETION AT 'NOTHING RETURNED' E . DORPT LA A0,CMDTAB+CTMODE,X7 LOAD COMMAND MODE BITS LA A1,PDTYPE,X8 LOAD TYPE OF THIS PARAMETER TNE,U A1,EITHER IS TYPE PROGRAM FILE CLASS ? JZ A15,SCNTPF YES. PICK UP TPF$ IF NO SPECS GIVEN TOP,U A0,OP ARE ZERO PARAMETERS MEANINGFUL ? JZ A15,OMPERR EVEN REPEAT MAY NOT HAVE ZERO PARAMETERS DOCOMMAND LA A1,CWOPTION LOAD COMMAND OPTIONS OR A1,IMPLOPT OR IN IMPLIED OPTIONS TNZ CMDTAB+CTIMM,X7 IMMEDIATE COMMAND ? SA A2,CWOPTION NO. STORE IMPLIED OPTIONS J CMPRO PROCESS COMMAND . . SCAN THE PARAMETER . parpres jne a2,'.',parrpres skip if not a period . . First character of specification is a period. See if the next . character is a space. If so, this is the end of line terminator . and there is no next specification. . u$char . look at next character je a2,' ',nomore if sequence is '. ', end statement e$skip -1 no. back up to period parrpres LA A0,PDTYPE,X8 LOAD TYPE OF PARAMETER J PARSCAN,A0 BRANCH ON TYPE . PARSCAN J SCNINT INTEGER - TYPE 0 J SCNFILE FILE - TYPE 1 J SCNSTR STRING - TYPE 2 J SCNDATA DATA - TYPE 3 J SCNDATA KEY - TYPE 4 J SCNBLK BLOCK - TYPE 5 J SCNIBL INTERNAL CURRENT BLOCK - TYPE 6 J SCNELT ELEMENT - TYPE 7 J SCNELT ELEMENT CLASS - TYPE 8 J SCNELT ELEMENT OR FILE - TYPE 9 J SCNETYP ELEMENT TYPE - TYPE 10 /. . . INTEGER PARAMETER SCANNER . SCNINT U$I . SCAN OFF THE NUMBER JZ A3,BADINT ERROR IF NO INTEGER FOUND JE A2,' ',INTOK CHECK DELIMITER JE A2,',',INTOK FOR LEGALITY J BADINT BAD DELIMITER. IT'S A MALFORMED INTEGER INTOK BGET PBL ALLOCATE A PARAMETER BUFFER SA A1,PBVAL,A0 PUT NUMBER WE SCANNED INTO THE BUFFER LA,U A1,NUMBER LOAD INTEGER TYPE SA A1,PBTYPE,A0 PUT TYPE IN ITEM SA A0,A5 SAVE ADDRESS E$SKIP 1 SKIP OVER DELIMITER LA A0,A5 RELOAD ADDRESS OF PARAMETER J SCNDONE DISPOSE OF RESULT /. . . STRING PARAMETER SCANNER . SCNSTR F$DT1 14,line SET TO STORE INTO LINE SCNS1 U$CHAR . SCAN A CHARACTER F$CHAR . STORE IT OUT JE A0,' ',SCNS2 CHECK FOR END IF BLANK JN A2,SCNS3 ALL DONE IF END OF IMAGE LA A2,PDFLAGS,X8 LOAD FLAGS FOR THIS PARAMETER TOP,U A2,PBFSEC SECRET PARAMETER ? J SCNS1 NO. TREAT NORMALLY E$SKIP -1 BACK UP OVER LAST CHARACTER E$CHAR '?' OBSCURE DATA IN LINE IMAGE J SCNS1 CONTINUE STRING SCAN SCNS3 F$COLN . GET CURRENT COLUMN POINTER LA,U A5,,A0 SAVE IT IN A5 AA,U A0,5 SET UP FOR COVERED DIVIDE DSL A0,36 MOVE INTO A0, A1 DI,U A0,6 A0 = WORD COUNT TO HOLD IT LR,U R1,,A0 LOAD LENGTH TO MOVE AA,U A0,PBSS ADD IN HEADER LENGTH BGET . ALLOCATE A BUFFER SA A5,PBVAL,A0 SAVE CHARACTER LENGTH LA,U A1,STRING LOAD THE TYPE SA A1,PBTYPE,A0 PUT IN THE BUFFER AU A0,(1,PBSS) FORM BUFFER POINTER LA A2,(1,LINE) LOAD SOURCE POINTER BT A1,,*A2 MOVE STRING TO BUFFER J SCNDONE PARAMETER ALL SCANNED . SCNS2 U$POS3 . FIND NEXT NON-BLANK JN A0,SCNS3 STOP IF ALL DONE J SCNS1 AND KEEP LOOKING /. . . FILE SPECIFICATION SCANNER . SCNFILE SZ ELTFLG SET NOT SCANNING ELEMENT SCNFILET DSZ QUAL CLEAR QUALIFIER DSZ FILENAME CLEAR FILE NAME SZ FCSIGN MARK NO F-CYCLE SPECIFIED SZ FCYCLE CLEAR F-CYCLE SNONZ RKEY CLEAR READ KAY SNONZ WKEY ...AND WRITE KEY SCAN QUAL,2 STORE INTO QUALIFIER LR,U R4,12 GET CHARACTER COUNT QFG1 U$CHAR . SCAN A CHARACTER JCL FNAME AN,AQUAL DELIM,QFG2 QFG2 JNE A0,'*',GOTFQ GOT FILE, NOT QUALIFIER IF NOT STAR J GETFILE IF THIS WAS QUALIFIER, GET FILE . AQUAL JGD R4,$+2 TOO MANY CHARACTERS ? J QFG1 YES. IGNORE IT STCHR . STORE CHARACTER INTO QUALIFIER J QFG1 LOOP FOR ANOTHER ONE . GOTFQ DL A1,QUAL LOAD QUALIFIER DS A1,FILENAME MOVE TO FILE NAME DSZ QUAL MARK NO QUALIFIER PRESENT J ENDFN INTERPRET FILE NAME DELIMITER . GETFILE SCAN FILENAME,2 SCAN OFF THE FILE NAME LR,U R4,12 GET COUNT FNG1 U$CHAR . GET A CHARACTER JCL FNAME AN,AFNM DELIM,ENDFN JE A0,'-',AFNM ...OR MINUS SIGN ENDFN JE A0,'.',FNEND DOT TERMINATES WHOLE SHEBANG JE A0,' ',FSEND SPACE TERMINATES SPECIFICATION JE A0,',',FSEND COMMA TERMINATES THIS FIELD JE A0,'/',KEYGET SLASH MEANS START OF KEY JE A0,'(',FCGET PARENTHESIS SIGNALS ADVENT OF F-CICLE J BADDELIM OTHERWISE, AN OBVIOUS ERROR . AFNM JGD R4,$+2 TOO MANY CHARACTERS ? J FNG1 YES. IGNORE EXTRAS STCHR . STORE CHARACTER OF FILE NAME J FNG1 CONTINUE SCANNING . FNEND TZ ELTFLG SCANNING AN ELEMENT ? J FSEND YES. DON'T PEEK AHEAD U$CHAR . GET CHARACTER AFTER THE DOT JE A0,',',FSEND COMMA TERMINATING SPECIFICATION IS O.K. JE A0,' ',FSEND END OF CARD IS O.K. ALSO J BADDELIM OTHERWISE, IT'S A BAD DELIMITER . FCGET U$CHAR . SCAN THE NEXT CHARACTER TE,U A0,'-' NEGATIVE RELATIVE F-CYCLE ? TNE,U A0,'+' NO. POSITIVE RELATIVE F-CYCLE ? J FCREL YES. SAVE SIGN FOR RELATIVE F-CYCLE SNONZ FCSIGN MARK ABSOLUTE F-CYCLE SPECIFIED E$SKIP -1 BACK UP TO SCAN CYCLE NUMBER FCRELS U$I . SCAN THE CYCLE NUMBER JZ A3,BADFCYC ERROR IF BAD SYNTAX JN A1,BADFCYC ...OR IF ABSOLUTE CYCLE IS NEGATIVE SA A1,FCYCLE SAVE THE CYCLE NUMBER LA A2,FCSIGN LOAD THE SIGN FOR F-CYCLE LA,U A0,999+1 LOAD LIMIT FOR ABSOLUTE CYCLE TNE,U A2,'-' IS IT NEGATIVE RELATIVE CYCLE ? LA,U A0,31+1 YES. LIMIT TO -31 MAXIMUM TNE,U A2,'+' IS IT POSITIVE RELATIVE CYCLE ? LA,U A0,1+1 YES. +1 IS THE MAXIMUM TG A1,A0 IS F-CYCLE NUMBER WITHIN RANGE ? J BADFCYC NO. REJECT IT U$CHAR . PICK UP DELIMITER JNE A0,')',BADFCYC MUST BE ')' TO BE ACCEPTED U$CHAR . PICK UP NEXT CHARACTER JE A0,'.',FNEND DOT TERMINATES FILE SPEC JE A0,' ',FSEND SPACE TERMINATES CARD JE A0,',',FSEND COMMA TERMINATES SPECIFICATION JE A0,'/',KEYGET SLASH SIGNALS KEYS COMING J BADDELIM OTHERWISE, BAD DELIMITER . FCREL SA A0,FCSIGN SAVE SIGN FOR RELATIVE F-CYCLE J FCRELS GO SCAN THE NUMBER . KEYGET SCAN RKEY,1 SCAN THE READ KEY LR,U R4,6 GET COUNT KYG1 U$CHAR . GET A CHARACTER JE A0,'/',GETWK SLASH MEANS START OF WRITE KEY JE A0,'.',FNEND DOT ENDS SPECIFICATION JE A0,',',FSEND COMMA ENDS SPECIFICATION JE A0,' ',FSEND SPACE ENDS ALL SPECIFICATIONS SA A0,A5 SAVE THE SCANNED CHARACTER E$SKIP -1 BACK UP OVER LAST CHARACTER E$CHAR '?' OBSCURE THE KEY CHARACTER LA A0,A5 RESTORE THE SCANNED CHARACTER JGD R4,$+2 IGNORE IF TOO MANY CHARACTERS J KYG1 ...ARE SPECIFIED STCHR . STORE CHARACTER IN READ KEY J KYG1 GET NEXT CHARACTER . GETWK SCAN WKEY,1 STORE INTO WRITE KEY LR,U R4,6 GET COUNT WYG1 U$CHAR . LOAD A CHARACTER JE A0,'/',BADDELIM SLASH NOT PERMITTED HERE JE A0,'.',FNEND DOT STOPS IT JE A0,',',FSEND COMMA ENDS SPECIFICATION JE A0,' ',FSEND SPACE ENDS ALL SPECIFICATIONS SA A0,A5 SAVE THE CHARACTER WE SCANNED E$SKIP -1 BACK UP OVER KEY CHARACTER E$CHAR '?' OBSCURE IT LA A0,A5 RESTORE THE CHARACTER JGD R4,$+2 ACCUMULATE THE KEY J WYG1 CONTINUE ACCUMULATING STCHR . STORE THE CHARACTER J WYG1 LOOP AROUND . . FILE SCANNED. NOW ASSOCIATE IT WITH AN FDT . FSEND . LA A0,FILENAME LOAD FILE NAME JZ A0,MIFILE CHECK FOR MISSING FILE NAME TNE A0,R15 IS IT ALL SPACES ? J MIFILE YES. MISSING FILE . . STEP 1. ATTACH A USE NAME . SZ HADASG CLEAR 'HAD TO ASSIGN' FLAG SZ OPTMIS CLEAR USE FILENAME AS INTERNAL NAME FLAG TZ QUAL ANY QUALIFIER SPECIFIED ? J NOBBY YES. GOTTA ATTACH USE NAME TZ FCSIGN NO. WAS THERE AN F-CYCLE ? J NOBBY F-CYCLE SUPPLIED. USE NAME IS NECESSARY SNONZ OPTMIS SET USE OPTIMISATION INVOKED DL A0,FILENAME LOAD FILE NAME DS A0,INTNAM USE FILE NAME AS INTERNAL NAME SZ INTNAM+2 CLEAR FILE NAME TO TEST 'DUMMY NAME' FITEM$ INTNAM,9 GET FILE ASSIGNMENT INFORMATION TZ,S1 INTNAM+6 IS FILE NAME A DUMMY NAME ? J UNFIQT NO. EXAMINE EQUIPMENT TYPE TNZ INTNAM+2 IS USER'S NAME A DUMMY NAME ? J UNASGN NO. ASSIGN THE FILE NAME ITSELF . . IF THE FILE NAME SPECIFIED BY THE USER WAS AN UNASSIGNED . @USE NAME (A 'DUMMY NAME'), WE MUST ATTACH OUR OWN @USE . NAME TO IT BEFORE ASSIGNING. THIS IS NECESSARY BECAUSE . WE MUST HAVE A WAY TO @FREE THE FILE AT THE END AND LEAVE . THE @USE NAME ATTACHED. WHAT WE REALLY NEED HERE IS A . @FREE OPTIONS FLAG IN THE FDT. . SZ OPTMIS CLEAR OPTIMISATION ON THIS FILE . NOBBY F$DT1 2,intnam SET UP FOR INTERNAL NAME F$FD1 ('FANG$-') EDIT CANNED PORTION F$OCTF 6,FANGINT EDIT SEQUENCE NUMBER LA A0,FANGINT LOAD SEQUENCE NUMBER AA,U A0,1 BUMP IT SA A0,FANGINT STORE IT OUT F$DT1 fll$,fl$ SET TO WORK ON THE MAIN LINE F$COPY 5,('@USE ') EDIT CSF$ FUNCTION F$FD2 INTNAM EDIT INTERNAL NAME F$CHAR ',' EDIT COMMA TNZ QUAL QUALIFIER SPECIFIED ? J FBE1 NO. SKIP EDITING IT F$FD2 QUAL EDIT THE QUALIFIER F$CHAR '*' EDIT A STAR FBE1 F$FD2 FILENAME EDIT THE FILE NAME TNZ FCYCLE WAS A CYCLE SPECIFIED ? J FBE2 NO. SKIP THIS F$CHAR '(' EDIT LEFT PARENTHESIS F$FD1 FCSIGN EDIT SIGN FOR F-CYCLE F$DECV FCYCLE EDIT THE CYCLE DESIGNATION F$CHAR ')' EDIT CLOSING PARENTHESIS FBE2 . LA,U A0,FL$ LOAD IMAGE ADDRESS LMJ X11,CSF PERFORM THE DYNAMIC @USE IERR . OOPS! BAD SYNTAX ON THE USE . . STEP 2. FIND FILE IDENTITY, ASSIGN IF NECESSARY . UNFIRE FITEM$ INTNAM,9 GET FILE INFORMATION UNFIQT LA,S1 A0,INTNAM+6 LOAD EQUIPMENT TYPE JZ A0,UNASGN UNASSIGNED. WE WILL HAVE TO ASSIGN IT LA A0,EQTTAB+EPTPROP,A0 LOAD PROPERTIES OF THIS FILE TOP,U A0,EPCOMM COMMUNICATIONS DEVICE ? J NCOMLN NO. MAKE SURE IT'S MASS STORAGE OR TAPE COMLCK LA A0,CMDTAB+CTMODE,X7 LOAD MODES FOR THIS COMMAND TOP,U A0,CL DOES COMMAND PERMIT COMMUNICATIONS . LINES TO BE USED FOR FILES ? J ILLEQP NO. ILLEGAL EQUIPMENT TYPE J EQIPOK YES. ACCEPT EQUIPMENT TYPE NCOMLN TOP,U A0,EPTAPE IS THIS A TAPE FILE ? TEP,U A0,EPMASS NO. IS IT MASS STORAGE ? J EQIPOK YES. EQUIPMENT TYPE IS OK J ILLEQP NO. REJECT USE OF THIS FILE EQIPOK . . . STEP 3. LOOK FOR AN FDT ALREADY FOR THIS FILE . LA A0,FDLIST GET HEAD OF FDT LIST FDSRC1 JZ A0,FDBUILD SKIP IF END OF FDT LIST DL A1,FDFN,A0 LOAD FILE NAME DTE A1,INTNAM+2 ARE FILE NAMES EQUAL ? J FDFAIL NO. LOOK AT NEXT FDT DL A1,FDQUAL,A0 LOAD QUALIFIER DTE A1,INTNAM+4 DO QUALIFIERS AGREE ? J FDFAIL NOT EQUAL. LOOK AT THE NEXT ONE LA,S4 A1,INTNAM+6 LOAD RELATIVE F-CYCLE LSSL A1,31 SHIFT OFF NEGATIVE BIT SSL A1,31 RIGHT JUSTIFY IT TP,XH2 INTNAM+6 WAS F-CYCLE NEGATIVE ? LNA,U A1,,A1 YES. COMPLEMENT F-CYCLE IN PACKET AA,U A1 PROTECT AGAINST -0 TNE A1,FDFC,A0 IS THIS THE RIGHT CYCLE ? J FDFREE YES. WE'VE LOCATED THE FDT FDFAIL LA A0,FDLINK,A0 LINK TO NEXT FDT J FDSRC1 CHECK IT OUT . FDFREE TZ OPTMIS WAS USE OPTIMISED OUT ? J FDFOUND YES. DON'T FREE AND DECREMENT SA A0,A6 SAVE ADDRESS OF FOUND FDT LA A0,FANGINT LOAD INTERNAL NAME SEQUENCE ANA,U A0,1 COUNT IT BACK DOWN SA A0,FANGINT STORE IT BACK F$DT1 fll$,fl$ SET UP THE EDITOR F$MSG FREECA EDIT '@FREE,A ' F$FD2 INTNAM EDIT ATTACHED INTERNAL NAME LA,U A0,FL$ GET IMAGE ADDRESS LMJ X11,CSF RELEASE @USE ASSOCIATION IERR . OOPS! SHOULDN'T EVER HAPPEN LA A0,A6 RESTORE LOCATED FDT ADDRESS FDFOUND SA A0,A1 SAVE LOCATED FDT POINTER TZ ELTFLG SCANNING AN ELEMENT SPECIFICATION ? J ELTFGX YES. RE-ENTER ELEMENT SCANNER FOR NAME BGET PBL GET A PARAMETER BUFFER SA A1,PBVAL,A0 SAVE FDT POINTER LA,U A1,FILE LOAD FILE PARAMETER TYPE SA A1,PBTYPE,A0 SAVE IT IN PARAMETER PACKET J SCNDONE RETURN PARAMETER . . STEP 4. BUILD PERMANENT FDT . FDBUILD BGET FDL ALLOCATE AN FDT SIZE BUFFER LX,U X11,,A0 SAVE ADDRESS LXI,U X11,1 GET INCREMENT FOR MOVE LA A1,(1,INTNAM) GET SOURCE POINTER LR,U R1,9 GET LENGTH TO MOVE BT X11,,*A1 MOVE FITEM$ INFORMATION TO FDT LA,S4 A1,INTNAM+6 LOAD RELATIVE F-CYCLE FROM FITEM$ PACKET LSSL A1,31 SHIFT OFF THE SIGN BIT SSL A1,31 RIGHT JUSTIFY THE MAGNITUDE TP,XH2 INTNAM+6 IS RELATIVE CYCLE NEGATIVE ? LNA,U A1,,A1 YES. INVERT SIGN ON F-CYCLE AA,U A1 PROTECT AGAINST MINUS ZERO SA A1,FDFC,A0 PUT THE F-CYCLE IN THE ITEM SZ FDLOCK,A0 CLEAR IN-USE SZ FDREADC,A0 CLEAR READ ACTIVE COUNT SZ FDWRITE,A0 CLEAR WRITE ACTIVE COUNT SZ FDPROT,A0 CLEAR PROTECTION MODE IN FDT sz fdlablm,a0 mark the tape label type unknown LA A1,FDEQT,A0 LOAD EQUIPMENT TYPE OF FILE LA A1,EQTTAB+EPTPROP,A1 LOAD FILE PROPERTY BITS SA A1,FDPROP,A0 SET PROPERTY BITS IN FDT SZ FDIPLC,A0 CLEAR IN-PROGRESS BLOCK COUNT LA A1,RKEY LOAD READ KEY SA A1,FDRK,A0 SAVE IT IN FDT LA A1,WKEY LOAD WRITE KEY SCANNED OFF SA A1,FDWK,A0 COPY INTO THE FDT LA A1,HADASG LOAD 'HAD TO ASSIGN' FLAG SA A1,FDFRF,A0 STORE INTO FREE FLAG . DO EQUIPMENT TYPE DEPENDENT SETUP LA,S1 A1,INTNAM+6 LOAD EQUIPMENT TYPE SSL A1,3 SHIFT OFF SPECIFIC TYPE LA A2,ITYPE,A1 LOAD INTERNAL TYPE JNE A2,TSINGLE,SOIT DON'T CHECK VOLUMES IF MASS STORAGE LA,S1 A3,INTNAM+8 LOAD NUMBER OF REELS IN THIS FILE TG,U A3,2 IS IT A MULTI-REEL FILE ? LA,U A2,TMULTI YES. LOAD MULTI-REEL TYPE SOIT SA A2,FDTYPE,A0 SET TYPE IN FDT SZ FDMSAD,A0 CLEAR ADDRESS/BLOCK NUMBER LA A2,ITBL,A1 LOAD ASSUMED BLOCK LENGTH SA A2,FDBLEN,A0 PUT LENGTH IN FDT . NOTE THAT THE SEQUENCE THESE OPERATIONS ARE DONE IN, AND . THE FACT THAT SCANNER IS THE ONLY ACTIVITY TO LINK/UNLINK . FDT'S OBVIATES THE NEED TO SET A LOCK FOR THIS OPERATION. LA A1,FDLIST LOAD FDT LIST HEAD SA A1,FDLINK,A0 CHAIN REST OF LIST TO NEW BUFFER SA A0,FDLIST ATTACH UPDATED CHAIN TO HEAD J FDFOUND PASS BACK THE FDT POINTER . . FILE WASN'T ASSIGNED. TRY TO ACQUIRE IT . UNASGN R$DIT . ENTER EDITING MODE E$MSG ASGAX EDIT 'ASG,AX ' TNZ QUAL ANY QUALIFIER SPECIFIED ? J USG1 NO. DON'T EDIT ONE E$FD2 QUAL EDIT QUALIFIER E$CHAR '*' EDIT STAR USG1 E$FD2 FILENAME EDIT FILE NAME TNZ FCSIGN WAS AN F-CYCLE SPECIFIED ? J USG2 NO. SKIP EDITING IT E$CHAR '(' EDIT THE LEFT PARENTHESIS E$FD1 FCSIGN EDIT THE SIGN FOR THE F-CYCLE E$DECV FCYCLE EDIT THE F-CYCLE NUMBER E$CHAR ')' EDIT CLOSING PARENTHESIS USG2 LA A0,RKEY LOAD READ KEY TNE A0,R15 ALL BLANK ? J USG3 YES. CHECK WRITE KEY E$CHAR '/' EDIT A SLASH LA A0,RKEY LOAD READ KEY LMJ A3,EKEY EDIT KEY INTO IMAGE LA A0,WKEY LOAD WRITE KEY TNE A0,R15 IS IT BLANK ? J USG4 YES FINISH UP EDITING USG5 E$CHAR '/' EDIT A SLASH BEFORE THE KEY LA A0,WKEY LOAD WRITE KEY LMJ A3,EKEY EDIT THE KEY USG4 E$CHAR '.' EDIT FINAL DOT LA,H2 A0,,X1 LOAD IMAGE ADDRESS LMJ X11,CSF SUBMIT REQUEST IERR . SHOULDN'T OUGHTA GET HERE ! TP A0 WAS IT A REJECT ? J USGREJ YES. CANNOT CONTINUE TZ A0 ANY WARNING TO CONVEY TO USER ? J USGWRN WARNING STATUS. GIVE MESSAGE R$DITX . TERMINATE EDITING MODE SNONZ HADASG SET MUST BE FREED FLAG J UNFIRE O.K., TRY THE FITEM$ AGAIN NOW . USGWRN SA A0,A6 SAVE STATUS RETURNED FROM CSF$ LMJ X5,PRINT PRINT THE COMMAND STATEMENT LA A0,A6 RELOAD STATUS LMJ X5,CSFSTR EDIT STATUS FROM CSF$ SNONZ HADASG MARK FILE MUST BE ASSIGNED J UNFIRE DONE ASSIGNING THIS FILE . USG3 LA A0,WKEY LOAD THE WRITE KEY TNE A0,R15 IS IT BLANK ? J USG4 YES. DONE WITH EDITING E$CHAR '/' EDIT A SLASH FOR READ KEY J USG5 NOW EDIT WRITE KEY . . KEY EDITOR . EKEY LR,U R2,5 LOAD LOOP COUNTER EKEY1 LSSC A0,6 SHIFT NEXT CHARACTER INTO POSITION AND,U A0,077 AND OFF THE CHARACTER JE A1,' ',,A3 RETURN IF BLANK E$CHAR . EDIT THE CHARACTER JGD R2,EKEY1 LOOP FOR ALL CHARACTERS J 0,A3 RETURN /. . . DATA PARAMETER SCANNER . . THIS GETS THE DATA THAT FOLLOWS THE COMMAND . . DATA LIST SYNTAX . . <DATA LIST> ::= <ITEM LIST> END . . <ITEM LIST> ::= <ITEM> ! <ITEM> <ITEM LIST> ! <ITEM>,<REPEAT COUNT> ! . (<ITEM LIST>) ! (<ITEM LIST>),<REPEAT COUNT> . . <ITEM> ::= <INTEGER> ! <STRING> . . <REPEAT COUNT> ::= <INTEGER> . . <STRING> ::= '<CHARACTER STRING>' . . <INTEGER> ::= <SIGN> <NUMBER> . . <NUMBER> ::= <DIGIT> ! <DIGIT> <NUMBER> . . <SIGN> ::= <EMPTY> ! + ! - . . <CHARACTER STRING> ::= <CHARACTER> ! <CHARACTER> <CHARACTER STRING> . . <DIGIT> ::= 0 ! 1 ! 2 ! 3 ! 4 ! 5 ! 6 ! 7 ! 8 ! 9 . . <CHARACTER> ::= <DIGIT> ! A ! B ! C ! ... ! Z ! . ! + ! - ! $ ! .... . . SCNDATA SZ PAMODE CLEAR PATCH ACCUMULATION MODE SZ MAMODE CLEAR MASK ACCUMULATION MODE SCNDERE E$DITX . TERMINATE SCAN OF COMMAND LMJ X5,PRINT PRINT THE COMMAND E$DITR DLPKT START SCANNING DATA LNA,U A8,1 SET UP SEQUENCE CHECK ACCUMULATOR LA,U A9 CLEAR TOTAL PATCH ITEM LENGTH SCNDRS SZ PARLEV CLEAR PARENTHESIS LEVEL SZ STKDEPTH CLEAR STACK DEPTH NEEDED SZ DATAS CLEAR ANY DATA SCANNED SZ CCALR CLEAR ALREADY READ FLAG . . GET DATA INPUT . DATANC TZ EOFHIT EOF ENCOUNTERED ? J DATEOF YES. HANDLE EOF IN DATA SCAN SZ CCALR CLEAR CARD ALREADY READ LA,U A0,13 LOAD LENGTH TO CLEAR SNONZ DATLN,A0 CLEAR DATA READ BUFFER JGD A0,$-1 CLEAR ALL OF IT JNDEM DABI BATCH FORMAT ? F$DT1 2,line NO. SET UP TO TYPE SOLICITATION TZ PAMODE ACCUMULATING PATCHES ? J PAED YES. REQUEST PATCH DATA TZ MAMODE MASK BEING SCANNED ? J MAED YES. SOLICIT MASK LA A0,('DATA ') LOAD SOLICITATION TYPEOUT LA A1,PDTYPE,X8 LOAD PARAMETER TYPE TNE,U A1,KEY SCANNING A KEY ? LA A0,('KEY: ') YES. EDIT MORE APPROPRIATE TEXT F$FD3 . EDIT THE SOLICITATION PAED1 . ON EOL>-1 F$CHAR EOL EDIT LINE TERMINATOR CHARACTER OFF EOL>-1 TREAD DATATR READ THE DATA IMAGE J SKADA START SCANNING THE IMAGE . PAED F$FD3 ('COR: ') ASK FOR CORRECTION CARDS J PAED1 TYPE OUT SOLICITATION . MAED F$FD3 ('MASK ') ASK FOR MASK J PAED1 TYPE OUT REQUEST . DABI READ$ DATLN,DATEOF READ IN THE DATA IMAGE LA A0,LINENO LOAD LINE NUMBER AA,U A0,1 INCREMENT IT BY ONE SA A0,LINENO UPDATE LINE NUMBER JOL 'N',NOLID SKIP EDITING FOR 'N' OPTION F$DT1 fll$,fl$ SET UP EDITOR TZ PAMODE ACCUMULATING PATCHES ? J PAED2 YES. EDIT CORRECTION INDICATOR TZ MAMODE ACCUMULATING MASK ? J MAED2 YES. INDICATE ON LISTING LA,U A0,DATELL LOAD DATA LISTING PREFIX LA A1,PDTYPE,X8 LOAD PARAMETER TYPE TNE,U A1,KEY IS IT A SEARCH KEY ? LA,U A0,KETELL YES. EDIT KEY PREFIX F$MSG . COPY THE PREFIX PAED3 F$DECF 6,LINENO EDIT LINE NUMBER F$CHAR '.' EDIT DOT F$COL TXCOL TAB TO TEXT COLUMN F$COPY 80,DATLN EDIT THE DATA STATEMENT F$PRT 1 PRINT THE LINE NOLID J SKADA GO AND SCAN THE DATA . PAED2 F$MSG PATELL EDIT PATCH INDICATOR J PAED3 FINISH EDITING LINE . MAED2 F$MSG MATELL EDIT MASK INDICATOR J PAED3 EDIT REST OF LISTING . . DATA ITEM SCANNER . SKADA LA A0,DATLN LOAD FIRST WORD OF INPUT LINE TNZ PAMODE SCANNING CORRECTIONS ? LA,U A0 NO. ABORT ISN'T ALLOWED TNE A0,('ABORT ') IS IT ABORT CORRECTIONS COMMAND ? J ABPAT YES. RIP OFF ACCUMULATED STUFF SO FAR E$COL 0 TAB TO FIRST COLUMN TNZ PAMODE LOOKING FOR PATCHES ? J DATANI NO. DON'T CHECK FIRST COLUMN U$CHAR . SCAN FIRST COLUMN OF IMAGE JE A0,'-',PCSGET '-' INDICATES CORRECTION CARD E$SKIP -1 BACK UP ONE CHARACTER DATANI SZ LWLP CLEAR LAST WAS LEFT PARENTHESIS U$POS3 . POSITION TO FIRST NONBLANK JN A2,DATANC IF OFF END, GET ANOTHER LINE E$COLN . SEE WHERE WE ARE TG,U A0,81 OFF END OF CARD ? J DATANC YES. GET ANOTHER ONE U$CHAR . LOOK AT FIRST CHARACTER OF ITEM JNUM A0,DATINT 0 - 9: NUMERIC JE A0,'+',DATINT +: NUMERIC JE A0,'-',DATINT -: NUMERIC JE A0,072,DATST QUOTE DELIMITS STRING START JE A0,'(',DATLP LEFT PARENTHESIS ? JE A0,')',DATRP HOW ABOUT RIGHT PARENTHESIS ? JE A0,'.',DATANC HONOUR CARD TERMINATOR JNE A0,'E',DATBAD ERROR. BAD ITEM ON DATA CARD U$CHAR . LOOKS LIKE 'END'. INVESTIGATE FURTHER JNE A0,'N',DATBAD NEXT SHOULD BE 'N' JNE A2,'D',DATBAD AND LAST SHOULD BE 'D' J DATEND GO AND INTERPRET THE SCANNED DATA . . INTEGER SCANNER . DATINT E$SKIP -1 BACK UP ONE CHARACTER U$I . SCAN IT AS AN INTEGER JZ A3,MFDI ERROR IF NO INTEGER SCANNED JE A2,' ',DIOK ALLOW SPACE JE A2,',',DIOK COMMA JE A2,')',DIOK AND CLOSE PARENTHESIS AFTER INTEGER J MFDI OTHERWISE, INTEGER IS BAD DIOK DS A0,VALBUF SAVE RESULT LA,U A0,DBL+1 LOAD LENGTHOF DATA BUFFER TZ VALBUF WAS IT A TWO WORD ITEM ? AA,U A0,1 YES. ACCOMODATE EXTRA WORD BGET . ALLOCATE A DATA BUFFER LA,U A1,NUMBER LOAD DATA TYPE SA A1,DBTYPE,A0 PUT IN THE BUFFER LA,U A1,1 LOAD ITEM LENGTH TZ VALBUF UNLESS IT'S TWO WORDS LONG LA,U A1,2 ...IN WHICH CASE WE SET UP 2 AS LENGTH SA A1,DBLEN,A0 PUT LENGTH IN BUFFER TE,U A1,1 COPY ONE WORD ? J DODL NO. WE SHOULD MOVE TWO LA A1,VALBUF+1 LOAD RESULT SCANNED SA A1,DBVAL,A0 PUT IN DATA BUFFER VALUE WORD J DAPUT PUT ITEM ON DATA QUEUE . DODL DL A1,VALBUF LOAD TWO WORD RESULT DS A1,DBVAL,A0 PUT IN RESULT WORDS J DAPUT PUT DATA BUFFER ON QUEUE . . STRING SCANNER . DATST LA,U A5 CLEAR LENGTH ACCUMULATED F$DT1 14,valbuf SET UP TO STORE RESULT DSTNXT U$CHAR . LOAD NEXT CHARACTER JN A0,SRMQ HANDLE MISSING QUOTE JE A0,072,STDE TERMINATING QUOTE ? JE A0,'#',STDFORCE OR FORCE CHARACTER FCSTD F$CHAR . STORE THE CHARACTER AA,U A5,1 BUMP LENGTH STORED J DSTNXT LOOP TO GET NEXT CHARACTER . STDFORCE U$CHAR . LOAD THE NEXT CHARACTER JN A0,SRMQ HANDLE RUNNING OFF END J FCSTD STORE ANY VALID CHARACTER . STDE DSL A5,36 SHIFT OVER TOTAL CHARACTER COUNT AA,U A6,5 SET FOR COVERED DIVIDE DI,U A5,6 COMPUTE NUMBER OF WORDS LA A0,A5 LOAD WORD COUNT IN A0 AA,U A0,DBL ADD LENGTH REQUIRED FOR DATA ITEM BGET . ALLOCATE A DATA ITEM SA A5,DBLEN,A0 SAVE LENGTH IN WORDS LA,U A1,STRING LOAD DATA TYPE SA A1,DBTYPE,A0 PUT TYPE IN BUFFER AU,U A0,DBVAL A1 = VALUE AREA POINTER LXI,U A1,1 SET UP INCREMENT LR R1,A5 LOAD NUMBER OF WORDS TO MOVE LA A2,(1,VALBUF) LOAD SOURCE POINTER BT A1,,*A2 MOVE DATA TO ITEM J DAPUT STORE THE RESULT . . LEFT PARENTHESIS HANDLER . DATLP SNONZ LWLP DISALLOW COMMA AFTER THIS ITEM LA A0,PARLEV LOAD PARENTHESIS LEVEL AA,U A0,1 INCREMENT IT SA A0,PARLEV UPDATE LEVEL TG A0,STKDEPTH NEW RECORD STACK DEPTH ? SA A0,STKDEPTH YES. RECORD IT FOR LATER ALLOCATION BGET DBL ALLOCATE A DATA BUFFER LA,U A1,LPAR LOAD DATA TYPE SA A1,DBTYPE,A0 PUT IN BUFFER J DAPUT PUT ITEM ON QUEUE . . RIGHT PARENTHESIS HANDLER . DATRP LA A0,PARLEV LOAD PARENTHESIS LEVEL ANA,U A0,1 DECREMENT IT SA A0,PARLEV UPDATE LEVEL JN A0,EXTRAR ERROR IF EXTRA RIGHT PARENTHESIS BGET DBL ALLOCATE A DATA BUFFER LA,U A1,RPAR LOAD CODE FOR RIGHT PARENTHESIS SA A1,DBTYPE,A0 PUT TYPE IN BUFFER J DAPUT PUT ITEM ON RESULT . . DATA ITEM DISPOSITION . DAPUT LA,U A1,,A0 LOAD ITEM ADDRESS SNONZ DATAS SET DATA BEING SCANNED INSERT DATAQ PUT ON THE DATA QUEUE SZ DBREPC,A1 CLEAR REPEAT COUNT IN ITEM TZ LWLP WAS IT A LEFT PARENTHESIS ? J DATANI YES. PROCESS NEXT ITEM U$CHAR . LOAD NEXT CHARACTER JE A0,' ',DATANI END OF ITEM IF BLANK JE A0,')',DATABU BACK UP IF ')' AFTER ITEM JE A0,'(',DATABU ALLOW '(' TO FOLLOW CERTAIN ITEMS JE A0,'.',DATANC DOT IS THE TERMINATOR JNE A0,',',BDAI 'BAD DELIMITER AFTER ITEM' U$I . SCAN THE REPEAT COUNT JZ A3,BREPC BAD REPEAT COUNT IF NONE FOUND JE A2,' ',RPCOK COUNT SHOULD BE TERMINATED BY SPACE JE A2,')',RPCOK OR RIGHT PARENTHESIS J BREPC OTHERWISE SOUND OFF RPCOK JZ A1,VFNY DISALLOW COUNT OF ZERO JN A1,VFNY OR LESS. LA A0,DATAQ+QHL GET ITEM POINTER SA A1,DBREPC,A0 PUT REPEAT COUNT IN PACKET J DATANI SCAN NEXT ITEM . DATABU E$SKIP -1 BACK UP TO LOOK AT ')' J DATANI PROCESS IT DATEOF SNONZ EOFHIT SET EOF ENCOUNTERED . . BUILD DATA FROM DATA ITEM CHAIN . DATEND LA A0,STKDEPTH LOAD MAXIMUM STACK DEPTH NEEDED TZ PARLEV IS PARENTHESIS LEVEL ZERO ? J MISSIR NO. MISSING RIGHT PARENTHESIS AA,U A0,1 WE NEED 1 MORE WORD THAN MAX PARLEV BGET . ALLOCATE A RECURSION STACK SA A0,A14 SAVE STACK ADDRESS . . COMPUTE BUFFER LENGTH REQUIRED . LX X5,A14 LOAD STACK ADDRESS SZ 0,X5 CLEAR FIRST ACCUMULATION COUNTER LA A3,DATAQ+QFL A3 = RUNNING DATA ITEM POINTER LENQL TNE,U A3,DATAQ LINKED BACK TO HEAD YET ? J ELENC YES. LENGTH IS NOW KNOWN LA A0,DBTYPE,A3 LOAD TYPE OF ITEM JE A0,LPAR,LCBU INCREMENT LEVEL IF '(' JE A0,RPAR,LCBD DECREMENT AND UPDATE LEVEL TOTAL FOR ')' . . PRIMITIVE ITEM: ADD LENGTH * REPEAT TO TOTAL . LA A0,DBLEN,A3 LOAD ITEM LENGTH IN WORDS TZ DBREPC,A3 WAS REPEAT SPECIFIED ? MSI A0,DBREPC,A3 SCALE LENGTH BY REPEAT COUNT AA A0,,X5 UPDATE TOTAL ON THIS LEVEL SA A0,,X5 AND REPLACE IT LENLNK LA A3,QFL,A3 LINK TO NEXT BUFFER J LENQL PROCESS NEXT LIST ITEM . LCBU AX,U X5,1 RAISE LEVEL SZ 0,X5 CLEAR TOTAL ON THIS LEVEL J LENLNK LINK TO NEXT ITEM . LCBD LA A0,,X5 LOAD TOTAL ON THIS LEVEL ANX,U X5,1 DROP LEVEL TZ DBREPC,A3 REPEAT SPECIFIED FOR THIS GROUP ? MSI A0,DBREPC,A3 YES. MULTIPLY LEVEL TOTAL BY COUNT AA A0,,X5 UPDATE LOWER LEVEL TOTAL SA A0,,X5 PUT IT BACK J LENLNK CHAIN TO NEXT BUFFER . ELENC LX X5,A14 RELOAD STACK START ADDRESS . . GENERATE DATA BUFFER FROM SCANNED PARAMETERS . LA A0,,X5 LOAD NUMBER OF WORDS REQUIRED TZ PAMODE SCANNING CORRECTIONS ? JZ A0,PAWIND WIND UP IF END DISCOVERED JZ A0,NODATA ERROR IF NO DATA SUPPLIED AA,U A0,PBL ADD PARAMETER HEADER LENGTH BGET . ALLOCATE A DATA PARAMETER LA,U A1,DATA LOAD 'DATA' TYPE SA A1,PBTYPE,A0 PUT TYPE IN BUFFER LA A1,,X5 LOAD LENGTH OF DATA BUFFER SA A1,PBVAL,A0 PUT LENGTH IN PARAMETER SA A0,A13 SAVE PARAMETER ADDRESS LX,U X6,PBSS,A0 SET UP X6 AS STORE POINTER LXI,U X6,1 INITIALISE INCREMENT ON STORE POINTER LA A3,DATAQ+QFL LOAD LINK TO FIRST BUFFER DILOOP TNE,U A3,DATAQ HAVE WE LINKED BACK TO QUEUE ? J DIEND YES. ALL DONE WITH GENERATION LA A0,DBTYPE,A3 LOAD TYPE OF THIS ITEM JE A0,LPAR,DISTACK PUSH STACK IF '(' JE A0,RPAR,DIUNSTK POP STACK IF ')' . DATA: COPY TO BUFFER REPEAT TIMES LR R2,DBREPC,A3 LOAD REPEAT COUNT JGD R2,$+1 DECREMENT IT SO 0 = 1 DILEM LR R1,DBLEN,A3 LOAD LENGTH OF DATA ITEM LA,U A0,DBVAL,A3 LOAD ADDRESS OF DATA LXI,U A0,1 LOAD INCREMENT BT X6,,*A0 MOVE DATA TO BUFFER JGD R2,DILEM ...AS MANY TIMES AS IT'S REPEATED DILINK LA A3,QFL,A3 LINK TO NEXT ITEM J DILOOP PROCESS NEXT ITEM . . SAVE POSITION ON STACK FOR '(' . DISTACK SX X6,,X5 STACK THE CURRENT POSITION + INCREMENT AX,U X5,1 INCREMENT STACK POINTER J DILINK CHAIN TO NEXT ITEM . . DO ITEM REPEAT AT ')' . DIUNSTK ANX,U X5,1 POP STACK LA,U A2,,X6 LOAD CURRENT BUFFER POSITION ANA,H2 A2,,X5 SUBTRACT POSITION AT PUSH TIME JZ A2,SKUNK SKIP THIS IF ZERO LENGTH LR R2,DBREPC,A3 LOAD REPEAT COUNT OF EXPRESSION JGD R2,UNSKE DECREMENT AND ENTER COPY LOOP J UNSKE HANDLE TRICKY UNSPECIFIIED COUNT . UNSKB LA A0,,X5 LOAD SAVED STARTING ADDRESS LR R1,A2 LOAD LENGTH TO MOVE BT X6,,*A0 COPY EXPRESSION VALUE UNSKE JGD R2,UNSKB DO IT REPEAT - 1 TIMES SKUNK J DILINK PROCESS NEXT ITEM . DIEND LA A0,A14 LOAD STACK BUFFER ADDRESS BRELP A0 RELEASE STACK BUFFER DIRIP REMOVE DATAQ REMOVE AN ITEM FROM DATAQ TNE,U A1,DATAQ END OF LIST ? J DIRDN YES. ALL DONE BRELP A1 RELEASE THE BUFFER J DIRIP KEEP ON RELEASING BUFFERS . DIRDN LA A0,A13 LOAD PARAMETER BUFFER ADDRESS TZ MAMODE SCANNING A MASK ? J MAWIND YES. WIND UP MASK SCAN TNZ PAMODE SCANNING PATCHES ? J DAWIND INSERT PARAMETER ON COMMAND LIST AA A9,PBVAL,A0 ADD LENGTH OF THE DATA SEGMENT AA,U A9,2 ADD LENGTH OF PREFIX REQUIRED LA,U A1,,A0 LOAD ADDRESS OF DATA ITEM INSERT PAQUE SAVE ON PATCH ACCUMULATION QUEUE SZ DATAS CLEAR DATA BEING SCANNED TNZ CCALR NEXT IMAGE ALREADY READ ? J PAWIND NO. THAT MEANS WE GOT AN END ? . . SCAN CORRECTION IMAGE . CCERG U$POS3 . ADVANCE TO NEXT NONBLANK JN A2,CORCER ERROR. MISSING FIRST NUMBER LA,U A10 CLEAR START WORD LNA,U A11,1 SET END WORD NEGATIVE U$I . SCAN THE FIRST NUMBER JN A1,CORCER DISALLOW NEGATIVE NUMBER LA,U A10,,A1 LOAD THE RESULT JZ A3,CORCER ERROR IF NO NUMBER SCANNED U$CHAR . SCAN NEXT CHARACTER JE A0,' ',PASTORE STORE RESULT IF SPACE JNE A0,',',CORCER ONLY COMMA IS LEGAL DELIMITER U$POS3 . POSITION BEFORE NUMBER JN A2,CORCER HANDLE MISSING NUMBER U$I . SCAN THE DELETE NUMBER JN A1,CORCER CHECK FOR NEGATIVE WORD NUMBER LA,U A11,,A1 LOAD IT IN A11 JZ A3,CORCER ERROR IF NO NUMBER U$CHAR . LOOK AT TRAILING DELIMITER JNE A0,' ',CORCER GOTTA BE A SPACE PASTORE JN A11,CKFSP SKIP CHECK IF NO SECOND NUMBER TLE A11,A10 SECOND NUMBER MUST BE > OR = FIRST J SEQERR OR THERE'S A SEQUENCE ERROR CKFSP TG A8,A10 MAKE SURE FIRST NUMBER > LAST CORR. J SEQERR IT ISN'T, SEQUENCE ERROR LA A8,A10 UPDATE CURRENT LAST NUMBER TN A11 DELETE NUMBER SPECIFIED ? LA A8,A11 YES. IT IS LAST WORD REFERENCED BGET PBL ALLOCATE A BUFFER SA,H1 A10,PBVAL,A0 PUT FIRST NUMBER SA,H2 A11,PBVAL,A0 ...AND SECOND NUMBER IN PACKET LA,U A1,CORCRD LOAD PARAMETER TYPE SA A1,PBTYPE,A0 SET PARAMETER TYPE LA,U A1,,A0 LOAD ADDRESS OF PARAMETER BUFFER INSERT PAQUE PUT ON PATCH ACCUMULATION QUEUE AA,U A9,2 ADD LENGTH OF PATCH DIRECTIVE J DATANC OBTAIN NEXT CARD . . HANDLE READING A '-' CARD . PCSGET TNZ DATAS SCANNING A DATA LINE ? J CCERG NO. SCAN IMMEDIATELY SNONZ CCALR SET CARD ALREADY READ J DATEND TREAT AS END OF DATA STRING . . GENERATE PATCH BUFFER FROM LIST ITEMS ON PAQUE . PAWIND E$DITX . TERMINATE EDITING OF DATA LINE E$DITR SCNPKT GET BACK ON IMAGE LINE LA A0,A9 LOAD LENGTH OF PATCH BUFFER NEEDED AA,U A0,PBSS+2 ADD HEADER LENGTH + TERMINATOR WORD BGET . ALLOCATE A PATCH BUFFER SA A0,CWPATCH SAVE ADDRESS OF PATCH BUFFER LA,U A1,PBUFR LOAD BUFFER TYPE SA A1,PBTYPE,A0 PUT TYPE IN BUFFER LX,U X6,PBSS,A0 X& POINTS TO FIRST DATA WORD LXI,U X6,1 SET UP INCREMENT FOR STORE LA,U A5 CLEAR WORDS ADDED INDICATOR LA,U A4 CLEAR CURRENT WORD INDICATOR BPB0 REMOVE PAQUE GET A PATCH ITEM TNE,U A1,PAQUE END OF LIST ? J BPB4 YES. WIND UP LA A0,PBTYPE,A1 LOAD TYPE OF THIS BUFFER JE A0,DATA,BPB2 DATA ? LA,H1 A0,PBVAL,A1 NO. IT'S A CORRECTION CARD ANA A0,A4 COMPUTE NUMBER OF WORDS TO COPY TP,XH2 PBVAL,A1 ANY DELETE SPECIFIED ? AA,U A0,1 NO. COPY ONE MORE WORD THEN SA,H1 A0,,X6 PUT IN PATCH BUFFER LA,H1 A4,PBVAL,A1 UPDATE CURRENT WORD AA,U A4,1 CURRENT WORD IS 1 AFTER SPECIFIED WORD SZ,H2 0,X6 CLEAR NUMBER OF WORDS TO DELETE LA,XH2 A0,PBVAL,A1 LOAD SECOND NUMBER FROM CORRECTION JN A0,BPB1 IF MISSING, THIS ESTABLISHES INSERT POIN ANA,H1 A0,PBVAL,A1 SUBTRACT FIRST NUMBER TO GET # DELETED AA,U A0,1 INCREMENT TO MAKE COUNT INCLUSIVE SA,H2 A0,,X6 PUT IN PATCH BUFFER LA,H2 A4,PBVAL,A1 UPDATE CURRENT WORD AA,U A4,1 INCREMENT SINCE LAST MENTIONED WAS DELET BPB1 AX,U X6,1 POINT TO NEXT PATCH BUFFER WORD SZ 0,*X6 CLEAR NUMBER TO ADD BPB3 BRELP A1 RELEASE THE ITEM BUFFER J BPB0 PROCESS NEXT PATCH ITEM . BPB2 AA A5,PBVAL,A1 ADD TOTAL LENGTH ADDED SZ 0,*X6 CLEAR # COPIED, # DELETED LA A0,PBVAL,A1 LOAD LENGTH OF DATA BUFFER SA A0,,*X6 SET UP NUMBER TO ADD LR R1,A0 LOAD NUMBER OF WORDS TO MOVE LA,U A0,PBSS,A1 LOAD START OF DATA AREA LXI,U A0,1 SET UP INCREMENT BT X6,,*A0 MOVE DATA TO PATCH BUFFER J BPB3 LOOP FOR NEXT ITEM . BPB4 LA A0,(0377777,-1) PUT TERMINATING SENTINEL IN BUFFER SA A0,,*X6 SET TO COPY REST OF BUFFER SZ 0,*X6 CLEAR ADD INDICATOR AT END OF BUFFER LA A0,CWPATCH LOAD PATCH BUFFER ADDRESS SA A5,PBVAL,A0 PUT LENGTH ADDED IN PBVAL FIELD J CMPRO GO AND PROCESS THE COMMAND . DAWIND E$DITX . TERMINATE DATA LINE SCAN E$DITR SCNPKT START SCANNING COMMAND AGAIN LA A0,A13 LOAD ADDRESS OF DATA BUFFER J SCNDONE PASS DATA PARAMETER BACK . MAWIND E$DITX . STOP SCANNING DATA E$DITR SCNPKT GET BACK COMMAND LINE LA A0,A13 LOAD DATA BUFFER ADDRESS LA,U A1,MBUFR LOAD MASK BUFFER TYPE SA A1,PBTYPE,A0 PUT IN BUFFER TYPE SA A0,CWMASK PUT IN CURRENT MASK WORD J CMPRO PROCESS COMMAND /. . . BLOCK PARAMETER SCANNER . SCNBLK SCAN QUAL,2 ACCUMULATE NAME IN QUALIFIER BUFFER LR,U R4,12 LOAD MAX PARAMETER LENGTH BNG1 U$CHAR . LOAD A CHARACTER JCL FNAME AN,LCBLK DELIM,BNG2 BNG2 . JE A0,'.',STBLK THE REST STOP THE SCAN JE A0,',',STBLK FOR NEXT PARAMETER JE A0,' ',STBLK OR END OF COMMAND J BADDELIM ANYTHING ELSE IS A NO NO . LCBLK JGD R4,$+2 MAXIMUM CHARACTERS EXCEEDED ? J BNG1 YES. IGNORE THIS CHARACTER STCHR . STORE THE CHARACTER J BNG1 LOOP FOR NEXT INPUT CHARACTER . . LOOK UP BLOCK FDT IN BLOCK CHAIN STBLK DL A1,QUAL GET THE BLOCK NAME TNZ BKLIST NO BLOCKS ALLOCATED ? J INBK RIGHT. ATTACH FIRST ONE LA A0,BKLIST LOAD BLOCK LIST HEAD BLCKT DTE A1,FDIN,A0 FOUND IT YET ? J NAFFEL NO. LEEP ON LOOKING J GOTBBA YES. BUILD A PARAMETER FOR IT NAFFEL TNZ FDLINK,A0 ANY NEXT FDT ? J INBK NO. END OF THE LINE AND DIDN'T FIND IT LA A0,FDLINK,A0 LINK TO NEXT ONE J BLCKT EXAMINE NEXT FDT . INBK BGET FDL ALLOCATE AN FDT DS A1,FDIN,A0 PUT BLOCK NAME IN FDIN FIELD . SEE COMMENT AFTER LABEL 'SOIT' IN THIS ELEMENT IF . YOU'RE WORRIED ABOUT NO LOCK ON THIS OPERATION. LA A1,BKLIST LOAD LIST HEAD SA A1,FDLINK,A0 ATTACH REST OF LIST TO NEW ONE SA A0,BKLIST ATTACH CHAIN TO THIS ONE SZ FDBLOCK,A0 MARK NO BLOCK ALLOCATED TO THIS ONE SZ FDLOCK,A0 CLEAR IN-USE INDICATOR SZ FDREADC,A0 SET READ COUNT TO ZERO SZ FDWRITE,A0 SET WRITE LOCK TO ZERO GOTBBA LA,U A1,,A0 SAVE FDT ADDRESS BGET PBL ALLOCATE A PARAMETER BUFFER SA A1,PBVAL,A0 PUT FDT ADDRESS IN PARAMETER LA,U A1,BLOCK LOAD TYPE SA A1,PBTYPE,A0 PUT INTO PARAMETER J SCNDONE PASS BACK THE THING . . 'SCAN' THE INTERNAL BLOCK . SCNIBL DL A0,(' ?INTERNAL? ') LOAD THE MAGIC NAME DS A0,QUAL JUST AS IF WE SCANNED IT SNONZ ZIMPLE SET NOTHING ACTUALLY SCANNED J STBLK PROCESS PARAMETER /. . . ELEMENT PARAMETER SCANNER . SCNELT SNONZ ELTFLG SET SCANNING AN ELEMENT SZ EXALL CLEAR ALL SELECTED FLAG LA,U A1 INIDCATE NO FDT FOR PURE ELEMENT NAME LA A0,PDTYPE,X8 LOAD PARAMETER TYPE JE A0,ELEMENT,ELTFGX SKIP FILE STUFF IF ELEMENT NAME ONLY . . SEE IF A FILE NAME IS PRESENT . E$COLN . GET COLUMN NUMBER LA,U A5,,A0 SAVE IT FOR LATER RESET U$CHAR . SCAN A CHARACTER JNE A0,'.',SELT1D IS IT A DOT ? LA A1,LASFDT YES. GET LAST FDT USED JNZ A1,ELTFGX IF THERE, USE LAST FILE AA,U A5,1 OTHERWISE BUMP POINTER,... J SELTN AND USE TPF$ SELT1 U$CHAR . SCAN A CHARACTER JE A0,'.',FILELT FILE PRESENT. GO SCAN IT SELT1D JE A0,' ',SELTN END OF PARAMETERS, NO FILE JE A0,',',SELTN END OF THIS PARAMETER, NO FILE J SELT1 KEEP ON SCANNING . . NO FILE SPECIFIED, USE TPF$ . SELTN LA A0,A5 RELOAD THE COLUMN POINTER E$COL . RESET TO START OF SPECIFICATION SELTN1 DSZ QUAL CLEAR TO NO QUALIFIER DL A0,(LJSF$2 'TPF$') LOAD FILE NAME DS A0,FILENAME SET UP FILE NAME SZ FCYCLE SET NO F-CYCLE SNONZ RKEY NO READ KEY... SNONZ WKEY ...AND NO WRITE KEY J FSEND PROCESS TPF$ FILE SPECIFICATION . . FILE SPECIFICATION PRESENT. SCAN IT . FILELT LA A0,A5 GET COLUMN THIS STARTS IN E$COL . RESET THE POINTER J SCNFILET ENTER FILE SCANNER . . . RETURN FROM FILE SCANNER TO GET ELEMENT NAME . ELTFGX SNONZ EXVERN CLEAR VERSION TO ALL SPACES SNONZ EXVERN+1 CLEAR LAST SIX CHARACTERS OF VERSION SZ EXTBIT CLEAR TYPE SELECTION BITS SA A1,EXFDT SAVE FDT ADDRESS TZ A1 SKIP IF ELEMENT NAME ONLY SA A1,LASFDT SAVE LAST FDT SPECIFIED SZ EXCYC CLEAR CYCLE SPECIFICATION SZ CLASGO CLEAR CLASS TYPE SCANNED . . SCAN TYPE AND ELEMENT NAME SKEVTR SCAN EXELTN,2 SCAN ELEMENT NAME TZ ZIMPLE SCANNING IMPLIED TPF$ SPECIFICATION ? J ESEND YES. DISPENSE WITH FORMALITIES LR,U R4,12 LOAD MAX CHARACTERS IN NAME GENY U$CHAR . SCAN A CHARACTER JA A0,ENOK ALPHABETICS ARE PERMITTED JNUM A0,ENOK NUMERICS ARE O.K. ALSO JE A0,'$',ENOK ALLOW DOLLAR SIGN... JE A0,'-',ENOK ...AND HYPHEN JE A0,'*',ENOKC STAR IS O.K., BUT FORCES TO CLASS JE A0,',',ESEND COMMA ENDS SPECIFICATION JE A0,' ',ESEND SPACE ENDS ALL SPECIFICATIONS JE A0,'/',VERGOT SLASH MEANS VERSION FOLLOWS JE A0,':',TYPGOT COLON MEANS THIS WAS A TYPE JE A0,'(',CYCGOT LEFT PARENTHESIS INDICATES A CYCLE FOLLO J BADDELIM OTHERWISE, ERROR FOR BAD DELIMITER . ENOKC SNONZ CLASGO SET CLASS TYPE SPECIFICATION ENOK JGD R4,$+2 SKIP IF TOO MANY CHARACTERS J GENY OVER 12. IGNORE STCHR . STORE THE SCANNED CHARACTER J GENY SCAN NEXT ONE . . COLON ENCOUNTERED: VERIFY VALID TYPE SPECIFICATION . TYPGOT LA A0,EXELTN LOAD SCANNED TYPE NAME LMJ X11,SELTLU LOOK UP TYPE ENTRY J ILTYM ILLEGAL TYPE SPECIFIED or a2,extbit or in previous selection bits SA A3,EXTBIT UPDATE ACCUMULATED TYPE BITS J SKEVTR RETURN TO SCAN THE NAME . . VERSION NAME SCANNER . VERGOT SCAN EXVERN,2 SCAN THE VERSION LR,U R4,12 LOAD ALLOWED LENGTH GENYV U$CHAR . SCAN A CHARACTER JA A0,VEROK ALLOW ALPHABETICS JNUM A0,VEROK AND NUMERICS JE A0,'$',VEROK AS WELL AS THE OTHER STUFF JE A0,'-',VEROK SUCH AS THIS JE A0,'*',VEROKC STAR FORCES IT TO A CLASS JE A0,',',VNGOT COMMA DELIMITS IT JE A0,' ',VNGOT SPACE ENDS IT ALSO JE A0,'(',VNGOT CYCLE SPECIFICATION ENDS VERSION J BADDELIM DON'T ALLOW OTHER STUFF . VEROKC SNONZ CLASGO SET CLASS TYPE SCANNED VEROK JGD R4,$+2 TOO MANY CHARACTERS SCANNED ? J GENYV YES. IGNORE THIS ONE STCHR . STORE OUT THE CHARACTER J GENYV SCAN THE NEXT ONE . VNGOT DL A0,EXVERN LOAD VERSION WE SCANNED OFF TE A0,R15 IS IT ALL BLANKS ? J VNGNB NO. SKIP FUDGING DL A1,('************') YES. CHANGE TO ALL STARS DS A1,EXVERN SET UP VERSION SNONZ CLASGO SET CLASS SCANNED VNGNB JE A0,'(',CYCGOT SCAN CYCLE IF ONE IS PRESENT J ESEND OTHERWISE, END THE SCAN . . CYCLE SCANNER . CYCGOT U$I . SCAN THE CYCLE SA A1,EXCYC SAVE CYCLE SCANNED U$CHAR . GET A CHARACTER TE,U A0,')' MUST BE CLOSE PARENTHESIS J BADECYC BAD ELEMENT CYCLE U$CHAR . GET FINAL DELIMITER JE A0,',',ESEND END IF IT'S A COMMA JE A0,' ',ESEND OR A SPACE J BADDELIM ANYTHING ELSE MUST BE WRONG . . END SPECIFICATION, BUILD PARAMETER BUFFER . ESEND DL A0,EXELTN LOAD ELEMENT NAME TE A0,R15 WAS SPECIFICATION NULL ? J ESEND1 NO. LET IT GO AS SPECIFIED TNE A0,EXVERN ANY VERSION SPECIFIED ? TZ EXTBIT ANY TYPES SELECTED ? J $+2 YES. APPLY SELECTION SNONZ EXALL NO. SET ALL SELCTED SNONZ CLASGO SET CLASS SCANNED DL A0,('************') CHANGE TO STARS DS A0,EXELTN STORE OUT NAME ESEND1 . . ** VERIFY CLASS ALLOWED FOR THIS TYPE ** BGET ELL ALLOCATE AN ELEMENT PARAMETER DL A1,EXELTN LOAD ELEMENT NAME DS A1,ELELTN,A0 PUT IN ELEMENT TABLE DL A1,EXVERN LOAD SCANNED VERSION DS A1,ELTVERN,A0 PUT AWAY VERSION LA A1,EXTBIT LOAD TYPE SELECTION BITS SA A1,ELTBIT,A0 SALT AWAY FOR FUTURE PERUSAL LA A1,EXFDT GET FILE ASSOCIATION SA A1,ELFDT,A0 PUT FILE ASSOCIATION IN TABLE LA A1,EXCYC LOAD CYCLE SCANNED SA A1,ELCYC,A0 SAVE IN ELEMENT TABLE LA A1,EXALL LOAD ALL SELECTED FLAG SA A1,ELALL,A0 PUT INTO THE CLASS DESCRIPTION LA,U A1,ELEMENT LOAD ELEMENT TYPE SA A1,PBTYPE,A0 SET TYPE IN PACKET TNZ ELFDT,A0 ELEMENT OR ELEMENT / FILE PARAMETER ? J SCNDONE ELEMENT ONLY. PUT ON PARAMETER QUEUE SZ PBFLAGS,A0 CLEAR FLAGS IN ELEMENT TYPE PARAMETER LA,U A1,,A0 GET PARAMETER ADDRESS INSERT PARQUE PUT ON PARMETER QUEUE . . NOW PASS A PARAMETER WHICH POINTS TO THE ASSOCIATED . FILE FOR THIS ELEMENT. THIS IS ESSENTIAL TO ALLOW . THE DISPATCHER TO HOLD THIS COMMAND UNTIL ITS FACILITY . REQUIREMENTS ARE MET. COMMAND PROCESSES WHICH USE . ELEMENTS MUST SKIP THE FILE PARAMETER WHICH FOLLOWS . THE ELEMENT. . BGET PBL GET A PARAMETER FOR THE FILE LA A2,ELFDT,A1 LOAD THE FDT ADDRESS SA A2,PBVAL,A0 SAVE THE FDT ADDRESS LA,U A1,FILE LOAD PARAMETER TYPE (FILE) SA A1,PBTYPE,A0 PASS TYPE OF FILE J SCNDONE TRANSMIT PARAMETER . . DUMMY UP TPF$ FOR MISSING PARAMETER . SCNTPF SNONZ ZIMPLE SET NOTHING REALLY SCANNED SNONZ ELTFLG SET SCANNING AN ELEMENT SZ EXALL SET ALL ELEMENTS NOT SELECTED J SELTN1 ENTER ELEMENT SCANNER /. . . ELEMENT TYPE PARAMETER SCANNER . SCNETYP SCAN EXELTN,2 STORE TYPE INTO ELEMENT NAME LR,U R4,12 ALLOW TWELVE INPUT CHARACTERS BTYG1 U$CHAR . SCAN THE NEXT CHARACTER JA A0,TYPACP ACCEPT IT IF ALPHABETIC jnum a0,typacp accept numeric types also JE A0,':',TYPDONL ALLOW COLON AS DELIMITER TYECK JE A0,' ',TYPINX STOP IF END OF LIST JE A0,',',TYPINX ...OR END OF PARAMETER J BADTYL GIVE MESSAGE FOR BAD LETTER . TYPACP JGD R4,$+2 ACCEPT IF LESS THAN 12 CHARACTERS IN J BTYG1 IGNORE IF OVER TWELVE STCHR . STORE THE CHARACTER J BTYG1 SCAN THE NEXT ONE . TYPDONL U$CHAR . SCAN THE NEXT CHARACTER J TYECK MUST BE PARAMETER DELIMITER . TYPINX LA A0,EXELTN LOAD ELEMENT TYPE NAME LMJ X11,SELTLU LOOK UP TYPE ENTRY J ILTYM NOT FOUND. GIVE A REBUKE BGET PBL ALLOCATE A PARAMETER BUFFER SA A1,PBVAL,A0 PUT TYPE IN VALUE FIELD LA,U A1,ELTYPE LOAD TYPE OF PARAMETER SA A1,PBTYPE,A0 PUT IN TYPE FIELD J SCNDONE PROCESS NEXT PARAMETER /. . . PUT PARAMETER BUFFER IN PARAMETER LIST . SCNDONE LA,U A1,,A0 GET ADDRESS OF THE PARAMETER LA A2,PDFLAGS,X8 LOAD FLAGS FOR THIS PARAMETER SA A2,PBFLAGS,A1 COPY FLAGS TO PARAMETER BUFFER INSERT PARQUE PUT IT ON THE PARAMETER QUEUE SCNNOPE AA,U A15,1 INCREMENT PARAMETERS PROCESSED TNZ CWREPEAT REPEAT MODE ? AX,U X8,PDEL NO. POINT TO NEXT PARAMETER E$COLN . GET CURRENT CURSOR POSITION LA A1,ZIMPLE LOAD NOTHING SCANNED FLAG SZ ZIMPLE CLEAR THE NOTHING SCANNED FLAG TG,U A0,80 OFF END OF IMAGE ? J NOMORE YES. END OF SCAN JNZ A1,GETNP PROCESS NEXT PARAMETER IF NOTHING WAS SC E$SKIP -1 BACK UP TO RESCAN DELIMITER U$CHAR . SCAN THE NEXT CHARACTER JE A0,' ',NOMORE SPACE MEANS END OF LIST JE A0,',',GETNP BUT COMMA MEANS THERE'S MORE TO COME J BADDELIM ERROR. BAD TRAILING DELIMITER . . THIS ROUTINE RELEASES ALL THE BUFFERS AND GETS ANOTHER COMMAND . COMMENT LMJ X5,PRINT PRINT THE COMMENT STATEMENT REJECT V CONCUR CLEAR CONCURRENCY COUNTDOWN FOR THIS COM J RIPOFF THROW AWAY PARAMETERS SCANNED SO FAR . . THIS ROUTINE WAITS FOR COMPLETION AFTER THE EOF IS RECIEVED . WINDDOWN SNONZ CLOSING TELL COMPLETE TO ADVISE US OF COMPLETION . . PASS A COMMAND TO TERMINATE THE DISPATCHER . BGET CDL GET A COMMAND BUFFER SZ CDBACT,A0 CLEAR ENTRY ADDRESS LA,U A1,,A0 COPY ADDRESS TO A1 FOR INSERT P CMDLOCK LOCK COMMAND TABLES INSERT CMDQUE PUT COMMAND ON QUEUE FOR DISPATCHER V CMDLOCK UNLOCK COMMAND TABLES V HAPPEN CYCLE THE DISPATCHER WINDCK TNZ OUTSTANDING ANY OUTSTANDING COMMANDS ? J WINDX NO. WE'RE ALL DONE P COMPLETED WAIT FOR SOMETHING TO COMPLETE J WINDCK SEE IF THAT WAS THE LAST ONE . WINDX . . . FREE FILES AND RELEASE FDT'S . . LOCKING IS UNNECESSARY SINCE AT THIS POINT WE ARE . THE ONLY ACIVITY LEFT RUNNING. . LX X9,FDLIST LOAD FDT LIST HEAD FFRL TNZ X9 WAS THIS THE LAST FDT ? J FRDN YES. DONE WITH FREE LOOP DSZ FDCRYK,X9 OVERSTORE KEY IN CORE, SO IT WILL . NOT BE IN DUMPABLE CORE TO NEXT USER. TNZ FDFRF,X9 NO. DO WE NEED TO FREE ? ON USEREL=0 J NOFRE NO. JUST RELEASE THE FDT OFF USEREL=0 ON USEREL J UNDOUSE RELEASE THE INTERNAL NAME OFF USEREL F$DT1 22,line SET UP THE EDITOR F$COPY 5,('@FREE ') EDIT @FREE COMMAND DL A1,FDIN,X9 LOAD INTERNAL NAME OF FILE LA,U A0,',AR' LOAD OPTIONS TO RELEASE USE AND FREE DTE A1,FDFN,X9 DID WE OPTIMISE THE FILE NAME ? F$FD1 . NO. MUST RELEASE USE NAME AND FREE IT F$SKIP 1 SKIP AFTER @FREE COMMAND FREERC F$FD2 FDIN,X9 COPY INTERNAL NAME LA,U A0,LINE LOAD ADDRESS OF @FREE IMAGE LMJ X11,CSF SUBMIT REQUEST IERR . AIN'T NO WAY TZ A0 WAS REQUEST ACCEPTED ? LMJ X5,CSFST NO. EDIT REJECT OR WARNING CODE NOFRE LA,U A0,,X9 SAVE ADDRESS OF THIS BUFFER LX X9,FDLINK,X9 CHAIN TO THE NEXT FDT BRELP A0 RELEASE THIS BUFFER J FFRL KEEP ON RELEASING THEM . ON USEREL UNDOUSE LA A1,FDIN,X9 LOAD INTERNAL NAME OF FILE TE A1,('FANG$-') DID WE ATTACH IT ? J NOFRE NO. DON'T FARBLE USER'S USE NAME F$DT1 22,line SET UP THE EDITOR ON LINE F$MSG FREECA EDIT @FREE,A IMAGE J FREERC GO RELEASE THE USE NAME OFF USEREL . . . FREE BLOCK FDT'S AND BUFFERS . FRDN LA A3,BKLIST LOAD HEAD OF BLOCK FDT LIST FRDN2 JZ A3,FRDN1 END OF BLOCK FDT LIST ? LA A0,FDBLOCK,A3 LOAD BLOCK ADDRESS JZ A0,FRDN3 SKIP RELEASE IF NO BLOCK ALLOCATED BRELP A0 RELEASE THE BLOCK BUFFER FRDN3 LA,U A0,,A3 SAVE BLOCK ADDRESS LA A3,FDLINK,A3 LINK TO NEXT FDT BRELP A0 RELEASE THIS FDT J FRDN2 LOOP FOR NEXT FDT FRDN1 V ENDLESS INFORM THE VULTURE WE'RE DONE EXIT . TERMINATE THIS PROCESS . . RELEASE UNPROCESSED PARAMETERS . ICOUT* . V CONCUR CLEAR CONCURRENCY COUNT . RIPOFF LA A0,CWPATCH LOAD PATCH BUFFER ADDRESS SZ CWPATCH CLEAR PATCH BUFFER PRESENT JZ A0,RIPPAM ANY PATCH BUFFER FOR THIS COMMAND ? BRELP A0 YES. RELEASE IT RIPPAM LA A0,CWMASK LOAD CURRENT MASK BUFFER JZ A0,RIPPAR HAS ONE BEEN ALLOCATED ? SZ CWMASK YES. CLEAR BUFFER ADDRESS BRELP A0 RELEASE THE BUFFER RIPPAR REMOVE PARQUE REMOVE AN ENTRY TNE,U A1,PARQUE IS IT THE END ? J CMDGET YES. GET ANOTHER COMMAND BRELP A1 RELEASE THE PARAMETER BUFFER J RIPOFF LOOK AGAIN /. . . COMMAND PROCESSING . CMPRO LMJ X5,PRINT PRINT THE IMAGE LA A0,CMDTAB+CTMODE,X7 LOAD COMMAND MODE BITS TEP,U A0,VO IS A MASK ACCEPTABLE ? J CMMASKE YES. SET UP FOR MASK SCAN MASKX TEP,U A0,UO ARE PATCHES PERMISSIBLE ? J CMPARED YES. INTERROGATE 'U' OPTION . ** CHECK FOR NON-ZERO DO LEVEL, QUEUE COMMAND IF NECESSARY ** PATCX TNZ CMDTAB+CTAD,X7 IS THE COMMAND IMPLEMENTED YET ? J SOLLY NO. GIVE A TEARFUL ERROR MESSAGE TNZ CMDTAB+CTIMM,X7 IS IT AN IMMEDIATE MODE COMMAND ? J ACTCMD NO. WILL HAVE TO PASS THROUGH QUEUE LA A0,CMDTAB+CTAD,X7 LOAD ADDRESS OF HANDLER ROUTINE J 0,A0 ENTER PROCESSING ROUTINE . CMPARED LA A1,CWOPTION LOAD OPTIONS TOP,U A1,OPTION('U') IS 'U' OPTION ON ? J PATCX NO. PROCEED WITH SCAN AND,XU A1,-OPTION('U') REMOVE OPTION SA A2,CWOPTION UPDATE OPTIONS SNONZ PAMODE SET SCANNING PATCHES J SCNDERE ENTER DATA SCANNER . CMMASKE LA A1,CWOPTION LOAD OPTIONS TOP,U A1,OPTION('V') SHOULD WE SCAN A MASK ? J MASKX NO. PROCESS COMMAND AND,XU A1,-OPTION('V') TAKE OFF 'V' OPTION SA A2,CWOPTION STORE OUT OPTION BITS SNONZ MAMODE SET SCANNING MASK J SCNDERE ENTER DATA SCANNER . . . PREPARE FACILITY INVENTORY FOR COMMAND . . SCAN THE PARAMETER CHAIN FOR READ-ONLY FILES. IF WE FIND A FILE . MARKED FOR READ-ONLY USE, WE FIRST CHECK WHETHER IT IS ASSIGNED . TO TAPE EQUIPMENT. IF SO, WE CLEAR READ-ONLY, FORCING SERIALISATION . OF THE COMMAND. THEN WE SCAN THE PARAMETER CHAIN TO SEE IF THE . FILE WHICH WAS USED READ-ONLY IS USED NON-READ-ONLY IN THE SAME . COMMAND. IF SO, WE SET ALL OCCURRENCES NON-READ-ONLY. THIS IS . NOT ESSENTIAL TO CORRECT OPERATION, BUT SAVES CONSIDERABLE TIME . IN THE DISPATCHER INNER LOOP, SINCE THE DISPATCHER NEED NOT . RUN AROUND CHECKING A READ-ONLY FILE, WHEN IT WILL ONLY REJECT THE . COMMAND DUE TO A LATER WRITE-MODE REFERENCE. . THIS CODE FORESHADOWS THE FACILITY SUMMARY TO BE BUILT IN LEVEL 2, . WHERE WITH THE FACILITIES/DISPATCHER REDESIGN, ASSIGNMENTS WILL BE . HANDLED AT COMMAND INITIATION TIME, AND FACILITY COMMANDS WILL . (IN RESPONSE TO POPULAR DEMAND) BE MADE SYNCHRONOUS. . ACTCMD LA A1,PARQUE+QFL LOAD LINK TO PARAMETER CHAIN ACFINXTR TNE,U A1,PARQUE END OF PARAMETER CHAIN ? J ACFIDONE YES. DONE SCANNING THIS COMMAND LA A2,PBFLAGS,A1 LOAD FLAGS FOR THIS PARAMETER TOP,U A2,PBFRO READ-ONLY USE IN THIS COMMAND ? J ACFINEXT NO. DON'T CHECK IT FURTHER LA A2,PBTYPE,A1 LOAD TYPE OF PARAMETER ON DEBUG TE,U A2,BLOCK IS IT A BLOCK ? TNE,U A2,FILE ...OR A FILE ? J $+2 BLOCK OR FILE, IT MAY BE READ ONLY IERR . PROBABLE COMMAND TABLE ERROR. READ-ONLY . PARAMETER WITH ILLEGAL TYPE. OFF DEBUG TE,U A2,FILE IS IT A FILE ? J ACFIBLK YES. DON'T CHECK ASSIGN TO TAPE LA A3,PBVAL,A1 A3 = FDT ADDRESS LA A3,FDTYPE,A3 A3 = FILE TYPE JTAPE A3,ACFIWRT SET WRITE MODE IF TAPE FILE . . SEARCH FOR WRITE MODE REFERENCE TO SAME FILE IN THIS COMMAND . ACFIBLK LA A3,PARQUE+QFL LOAD LINK TO PARAMETER CHAIN ACFIW1 TNE,U A3,PARQUE ENF OF PARAMETER CHAIN ? J ACFINEXT YES. THIS PARAMETER IS REALLY READ-ONLY LA A4,PBFLAGS,A3 LOAD FLAGS FOR THIS PARAMETER TOP,U A4,PBFRO IS PARAMETER READ-ONLY ? TE A2,PBTYPE,A1 AND SAME TYPE AS ONE UNDER EXAMINATION ? J ACFIW2 NO. LOOK AT NEXT PARAMETER LA A4,PBVAL,A3 LOAD FDT ADDRESS FOR THIS PARAMETER TE A4,PBVAL,A1 IS THIS THE SAME FDT AS OUR FILE ? J ACFIW2 NO. LOOK AT NEXT PARAMETER ACFIWRT LA A2,PBFLAGS,A1 LOAD FLAG BITS FOR THIS PARAMETER AND,U A2,-PBFRO REMOVE READ-ONLY MODE BIT SA A3,PBFLAGS,A1 UPDATE PARAMETER MODE BITS J ACFINEXT GO CHECK NEXT PARAMETER ACFIW2 LA A3,PBLINK,A3 CHAIN TO NEXT PARAMETER J ACFIW1 CHECK IT AGAINST THE SUBJECT PARAMETER ACFINEXT LA A1,PBLINK,A1 CHAIN TO NEXT PARAMETER J ACFINXTR CHECK IT FOR READ-ONLY MODE ACFIDONE TZ CWREPEAT REPEAT MODE COMMAND ? J RPTBLD YES. SPAWN MANY SUB-COMMANDS BGET CDL ALLOCATE A COMMAND BUFFER LA A1,CMDTAB+CTAD,X7 LOAD ENTRY ADDRESS SA A1,CDBACT,A0 SAVE START ADDRESS SZ CDBPC,A0 CLEAR PARAMETER LIST LINK INITQ CDELTQ,A0 INITIALISE ELEMENT QUEUE ANA,U A0,CDELTQ BACK UP TO START OF COMMAND BUFFER SZ CDBUFC,A0 CLEAR BUFFER CHAIN POINTER LA A1,PARQUE+QFL LOAD HEAD OF PARAMETER LIST TNE,U A1,PARQUE ANY PARAMETERS ? J PARQSU NO. SKIP LINKING TO COMMAND SA A1,CDBPC,A0 LINK PARAMETERS TO COMMAND LA A1,PARQUE+QHL LOAD LINK TO LAST PACKET SZ QFL,A1 CLEAR LAST LINK TO ZERO PARQSU LA A1,CWOPTION LOAD OPTIONS SA A1,CDOPTS,A0 SAVE OPTIONS APPLYING TO THIS COMMAND SZ CDRB,A0 CLEAR ROADBLOCKED FLAG SZ CDCEASE,A0 CLEAR CEASE FLAG LA A1,CWPATCH LOAD CURRENT PATCH BUFFER ADDRESS SA A1,CDPATCH,A0 LINK TO COMMAND SZ CWPATCH CLEAR PATCH BUFFER ADDRESS LA A1,CWMASK LOAD MASK BUFFER ADDRESS SA A1,CDMASK,A0 CHAIN TO COMMAND SZ CWMASK CLEAR MASK BUFFER ALLOCATED LA,U A1,,A0 SAVE ADDRESS OF COMMAND BUFFER LA,U A0,IML LOAD LENGTH OF IMAGE BUFFER AA A0,CWDOLEV ALLOCATE SUBSCRIPT NUMBER WORDS BGET . REQUEST AN IMAGE BUFFER LA A2,SASLN LOAD LINE NUMBER SA A2,IMLN,A0 PUT IN IMAGE BUFFER SZ IMRN,A0 CLEAR REPEAT MODE NUMBER LA A2,CWDOLEV LOAD NUMBER OF SUBSCRIPTS SA A2,IMNS,A0 SET UP SUBSCRIPT COUNT FOR IMAGE LA,U A2,IMIMG,A0 LOAD IMAGE START ADDRESS LXI,U A2,1 SET UP INCREMENT LA A3,(1,CRDBUF) LOAD SOURCE POINTER LR,U R1,14 LOAD LENGTH TO MOVE BT A2,,*A3 MOVE COMMAND IMAGE TO BUFFER SA A0,CDIMG,A1 LINK IMAGE TO COMMAND BUFFER P CMDLOCK LOCK COMMAND QUEUES INSERT CMDQUE PUT ON UNPROCESSED QUEUE LA A0,OUTSTANDING LOAD OUTSTANDING COUNT AA,U A0,1 COUNT IT UP SA A0,OUTSTANDING STORE OUT COUNT V CMDLOCK UNLOCK COMMAND QUEUES V HAPPEN WAKE UP THE DISPATCHER INITQ PARQUE REINITIALISE PARAMETER QUEUE J CMDGET GET THE NEXT COMMAND . . REPEAT MODE COMMAND CONSTRUCTION . RPTBLD LA,U A6 CLEAR SEGMENT NUMBER RPTBL1 REMOVE PARQUE REMOVE A PARAMETER TNE,U A1,PARQUE END OF QUEUE ? J RPTEND YES. DONE WITH THIS STEP TE,U A15,1 SINGLE PARAMETER TO REPEAT ? AA,U A6,1 BUMP SUBSTATEMENT NUMBER BGET CDL GET A COMMAND BUFFER LA A2,CMDTAB+CTAD,X7 LOAD ENTRY ADDRESS SA A2,CDBACT,A0 PUT INTO COMMAND SA A1,CDBPC,A0 CHAIN PARAMETER TO COMMAND SZ QFL,A1 CLEAR PARAMETER'S FORWARD LINK INITQ CDELTQ,A0 INITIALISE ELEMENT QUEUE ANA,U A0,CDELTQ BACK UP TO START OF COMMAND SZ CDBUFC,A0 CLEAR BUFFER CHAIN POINTER LA A1,CWOPTION LOAD OPTIONS SCANNED SA A1,CDOPTS,A0 PUT OPTIONS IN COMMAND SZ CDRB,A0 CLEAR ROADBLOCKED INDICATOR SZ CDCEASE,A0 CLEAR CEASE FLAG LA A1,CWPATCH LOAD PATCH BUFFER ADDRESS SA A1,CDPATCH,A0 LINK TO COMMAND PACKET SZ CWPATCH CLEAR PATCH BUFFER ADDRESS LA A1,CWMASK LOAD MASK ADDRESS SA A1,CDMASK,A0 ATTACH MASK TO COMMAND SZ CWMASK CLEAR MASK ALLOCATED LX,U X9,,A0 SAVE COMMAND BUFFER ADDRESS LA A2,CDBPC,X9 LOAD PARAMETER CHAIN HEAD LA A1,PBTYPE,A2 LOAD PARAMETER TYPE TE,U A1,ELEMENT IS IT AN ELEMENT ? J GIMEL NO. PROCESS NORMALLY REMOVE PARQUE YES. GET ASSOCIATED FILE TNE,U A1,PARQUE MISSING ? IERR . YEP. SA A1,QFL,A2 ATTACH TO COMMAND SZ QFL,A1 CLEAR FORWARD LINK ON FILE GIMEL LA,U A0,IML LOAD LENGTH OF NORMAL IMAGE BUFFER AA A0,CWDOLEV ADD CURRENT DO LEVEL BGET . ALLOCATE AN IMAGE BUFFER LA A1,SASLN LOAD STATEMENT NUMBER SA A1,IMLN,A0 PUT IN IMAGE BUFFER LA A1,CWDOLEV LOAD DO LEVEL SA A1,IMNS,A0 SET NUMBER OF SUBSCRIPTS FOR IMAGE SA A6,IMRN,A0 PUT SUBSTATEMENT NUMBER IN BUFFER SA A0,CDIMG,X9 CHAIN IMAGE TO COMMAND LX,U A0,IMIMG,A0 LOAD IMAGE ADDRESS LXI,U A0,14 AND LENGTH F$DT1 . ENTER FDITING MODE F$FD2 CMDTAB+CTNAME,X7 EDIT COMMAND NAME F$SKIP 1 SKIP A SPACE LX X10,CDBPC,X9 LOAD PARAMETER ADDRESS LMJ X6,PARFED EDIT PARAMETER LA,U A1,CDBQ,X9 LOAD DATA HEAD ADDRESS P CMDLOCK LOCK COMMAND TABLES INSERT CMDQUE PUT COMMAND ON QUEUE TO BE PROCESSED LA A0,OUTSTANDING LOAD OUTSTANDING COMMAND COUNT AA,U A0,1 DECREMENT IT SA A0,OUTSTANDING STORE IT BACK V CMDLOCK UNLOCK COMMAND TABLES V HAPPEN ANOTHER COMMAND TO DO J RPTBL1 PROCESS NEXT SUBSTATEMENT . RPTEND . J CMDGET GET NEXT COMMAND . . PARAMETER EDITOR . PARFED LA A0,PBTYPE,X10 LOAD TYPE OF COMMAND J $+1,A0 BRANCH ON TYPE J PFNUM NUMBER J PFFIL FILE J PFSTR STRING J 0,X6 DATA (DON'T EDIT) J 0,X6 KEY (DON'T EDIT) J 0,X6 BLOCK (DON'T EDIT) J 0,X6 INTERNAL BLOCK (DON'T EDIT) J PFELT ELEMENT J PFELT ELEMENT CLASS J 0,X6 EITHER (CAN'T GET HERE) J PFETY ELEMENT TYPE . PFNUM F$DECV PBVAL,X10 EDIT NUMERIC VALUE J 0,X6 RETURN . PFFIL LX X10,PBVAL,X10 GET FDT POINTER SZ ELTFLG CLEAR EDITING ELEMENT PFFLT DL A0,FDIN,X10 LOAD INTERNAL NAME DTE A0,FDFN,X10 WAS ONLY FILE NAME SPECIFIED ? J $+2 NO. EDIT WHOLE NAME J PFL1 YES. EDIT ONLY THE FILE NAME TNZ FDQUAL,X10 ANY QUALIFIER ? J PFL1 NO. DON'T EDIT IT F$FD2 FDQUAL,X10 EDIT THE QUALIFIER F$CHAR '*' EDIT THE STAR PFL1 F$FD2 FDFN,X10 EDIT THE LINE NAME TNZ FDFC,X10 WAS THERE AN F-CYCLE ? J PFL2 NO. SKIP EDITING F$CHAR '(' EDIT LEFT PARENTHESIS LA,U A0,'+' LOAD A PLUS SIGN TN FDFC,X10 NEGATIVE F-CYCLE ? F$CHAR . NO. EDIT PLUS SIGN F$DECV FDFC,X10 EDIT F-CYCLE F$CHAR ')' EDIT RIGHT PARENTHESIS PFL2 LA A0,FDRK,X10 LOAD READ KEY TNE A0,R15 IS IT BLANK ? J PFL3 YES. DON'T EDIT IT F$CHAR '/' EDIT A SLASH F$COPY 6,FDRK,X10 COPY THE KEY LA A0,FDWK,X10 LOAD WRITE KEY TNE A0,R15 MISSING ? J PFL4 YES. PFL5 F$CHAR '/' EDIT A SLASH F$COPY 6,FDWK,X10 EDIT THE WRITE KEY PFL4 F$CHAR '.' EDIT TRAILING DOT TZ ELTFLG EDITING ELEMENT ? J PFEFNR YES. JUMP BACK AND EDIT ELEMENT J 0,X6 RETURN PFL3 LA A0,FDWK,X10 LOAD WRITE KEY TNE A0,R15 IS IT BLANK ? J PFL4 YES. DONE WITH FILE F$CHAR '/' NO. NEED TO FLAG MISSING READ KEY J PFL5 GO EDIT WRITE KEY . PFSTR LA A1,PBVAL,X10 LOAD LENGTH LA,U A0,PBSS,X10 LOAD START ADDRESS F$COPY . MOVE STRING TO BUFFER J 0,X6 RETURN . PFELT LA A0,ELFDT,X10 LOAD FDT ADDRESS JZ A0,EELTN SKIP IF NO FILE SPECIFIED (ELEMENT TYPE) DL A1,FDIN,A0 LOAD INTERNAL NAME DTE A0,FDFN,X10 SIMPLE NAME ? J PFEFN NO. MUST EDIT FILE NAME TE A0,('TPF$ ') WELL, IS IT TPF$ ? J PFEFN NO. HAVE TO EDIT IT . EELTN LA A4,ELTBIT,X10 LOAD TYPE SELECTION BITS ETN1 JZ A4,ELTNTB STOP IF NO BITS SET lr,h2 r1,sstyp$ load number of system types la,u a3,1*/(gttype+1) load first eligible type bit la,u a2,sstyp$+2 load pointer to first entry jgd r1,$+1 decrement length to test eeltst jgd r1,$+2 more types to test ? j etn2 no. go test our types top a3,a4 is this bit set ? j etn1a no. skip this entry f$fd1 0,a2 edit the type name f$char ':' place colon after it xor a3,a4 update bits left to edit etn1a lssl a3,1 shift mask left aa,u a2,1 advance to next system type jnz a3,eeltst go see if more to edit . etn2 jz a4,eltntb skip if all types done LR,U R1,SELTBL-1 LOAD TABLE LENGTH LA A0,(2,0) LOAD SEARCH POINTER SELTLK LA A1,SELTAB+1,*A0 LOAD THE BITS FOR AN ENTRY AND A1,A4 AND WITH TARGET BITS TE A1,A2 ARE ALL BITS OF THIS TYPE IN THE MASK ? JGD R1,SELTLK NO. TRY NEXT ONE XOR A1,A4 TURN OFF FOUND BITS LA A4,A2 REPLACE RUNNING MASK F$FD1 SELTAB-2,A0,H2 EDIT THE NAME F$CHAR ':' EDIT THE TRAILING COLON J etn2 LOOP TO PROCESS NEXT BITS COMBINATION ELTNTB DL A0,ELELTN,X10 LOAD ELEMENT NAME DTE A0,('************') IS IT SELECT ALL ? J $+2 NO. EDIT THE SELECTION SPECIFICATION J ELTVEX YES. SKIP THE NAME EDITING F$FD2 . EDIT THE NAME ELTVEX LA A0,ELTVERN,X10 LOAD VERSION TNE A0,R15 ANY VERSION SPECIFIED ? J GOCKC NO. SKIP VERSION EDITING F$CHAR '/' YES. EDIT SLASH DL A0,ELTVERN,X10 LOAD VERSION SPECIFICATION DTE A0,('************') ALL STARS ? J $+2 NO. EDIT IT J GOCKC YES. THAT'S ENOUGH F$FD2 . EDIT VERSION GOCKC TNZ ELCYC,X10 ANY CYCLE SPECIFIED ? J NOECYG NO. SKIP THIS F$CHAR '(' YES. EDIT LEFT PARENTHESIS F$DECV ELCYC,X10 EDIT CYCLE F$CHAR ')' EDIT RIGHT PARENTHESIS NOECYG J 0,X6 RETURN PFEFN LXI,U X6,,X10 SAVE PARAMETER ADDRESS LX X10,ELFDT,X10 GET FDT ADDRESS FOR FILE EDITOR SNONZ ELTFLG SET ELEMENT FLAG J PFFLT EDIT THE FILE NAME . PFEFNR SZ ELTFLG CLEAR ELEMENT MODE LA A0,X6 LOAD SAVED PARAMETER ADDRESS SSL A0,18 RIGHT JUSTIFY PARAMETER ADDRESS LX X10,A0 RELOAD PARAMETER ADDRESS TZ ELALL,X10 ALL ELEMENTS (WHOLE FILE) SELECTED ? J NOECYG RIGHT. DON'T EDIT ANY ELEMENT STUFF J EELTN EDIT THE ELEMENT . PFETY LA A0,PBVAL,X10 LOAD TYPE VALUE tg,u a0,0100 is it a symbolic subtype ? j pfesty yes. get from system table LA A1,(2,0) LOAD SEARCH POINTER LR,U R1,SELTBL GET TABLE LENGTH SE,H1 A0,SELTAB,*A1 LOOK FOR TYPE IN TABLE IERR . OOPS! SOMEBODY GOOFED F$FD1 SELTAB-2,A0,H2 EDIT THE TYPE MNEMONIC J 0,X6 RETURN . pfesty and,u a0,077 isolate subtype bits f$fd1 sstyp$+1,a1 edit the type mnemonic j 0,x6 return to caller /. . . CONTINGENCY ROUTINE . IMPURE CODE SHIGGY RES 2 CONTINGENCY INFORMATION J GAZD ENTER REENTRANT CONTINGENCY ROUTINE PURE CODE GAZD SA A0,CSAVE SAVE A0 LA,T1 A0,SHIGGY LOAD TYPE AND CODE TNE,U A0,0205 BAD ADD STATEMENT ? J BADADD YES. RETYPE REQUEST SSL A0,6 SHIFT OFF ERROR CODE TE,U A0,4 IT'D BETTER BE ERR$ MODE ENTRY J ZAP NO. LET HIM HAVE IT LA,S2 A0,SHIGGY LOAD ERROR TYPE TG,U A0,040 IS IT IN CSF$ RANGE ? TG,U A0,043+1 (CSF$ ERRORS ONLY ARE RECOVERED) J ZAP NO. WIPE OUT LA A0,CSAVE RELOAD A0 CEND$ . TERMINATE CONTINGENCY MODE J 0,X11 RETURN TO ERROR RETURN OF CSF CALL ZAP IALL$ 0,,1 CLEAR ACTIVITY CONTINGENCY LA,H2 A0,SHIGGY LOAD REENTRY ADDRESS ANA,U A0,1 BACK IT UP TO THE OFFENDING INSTRUCTION SA,H2 A0,ZAJB STORE INTO THE RETURN JUMP LA A0,CSAVE RELOAD USER'S A J ZAJB JUMP TO RETURN INSTRUCTION IMPURE CODE ZAJB J $-$ RETURN TO BAD INSTRUCTION PURE CODE . BADADD CEND$ . DON'T NEED GOD-AWFUL PRIORITY DECRT LA A0,LINENO LOAD LINE NUMBER ANA,U A0,1 BACK IT UP FOR RESUBMISSION SA A0,LINENO PUT IT BACK IN THE LINE NUMBER J ICOUT GO GET ANOTHER COMMAND . . SCANNING SUBROUTINES . . THESE ROUTINES PROVIDE A FAST FACILITY FOR ACCUMULATING . ALPHANUMERIC INFORMATION IN A SPACE-FILLED BUFFER. . . . SCANNER SETUP: CLEAR LINE, SET UP REGISTERS . SCAN1 LX,U X5,,A0 LOAD IMAGE ADDRESS LX X6,(1,0) LOAD CHARACTER POINTER LXI,U X5,2 LOAD INCREMENT FOR X5 LXI,U A0,1 LOAD INCREMENT IN A0 SNONZ 0,*A0 CLEAR IMAGE JGD R1,$-1 LOOP FOR ALL WORDS J 0,X11 RETURN . . STORE CHARACTER EX TABLE . STCHR . I DO 2 ,J DO 6 , SA,U-J A0,I-1,X5 LMJ X11,$+1 SA,S1 A0,2,*X5 STORE OUT NEXT CHARACTER LXM,U X6,1 RESET CHARACTER POINTER J 0,X11 RETURN /. . . PRINT CURRENT IMAGE FOR BATCH . . THIS ROUTINE IS CALLED AFTER ALL PARAMETERS ON A CARD HAVE BEEN . SCANNED. THE IMAGE MAY NOT BE PRINTED BEFORE THIS TIME SINCE . ALL PARAMETERS MUST BE SCANNED SO AS TO OBSCURE ANY POSSIBLE . SECRET INFORMATION APPEARING ON THE STATEMENT. . PRINT F$DT1 fll$,fl$ START UP EDITOR ON CANNED LINE JDEM 0,X5 IGNORE IF CALL FROM DEMAND TZ PRINTYET HAS IMAGE BEEN PRINTED ALREADY ? J 0,X5 YES. ERROR ROUTINE PRINTED IT SNONZ PRINTYET SET IMAGE HAS BEEN PRINTED F$SKIP 10 TAB TO COLUMN 10 F$DECF 6,LINENO EDIT CURRENT STATEMENT NUMBER F$CHAR '.' EDIT A PERIOD AFTER IT F$COL TXCOL TAB TO TEXT COLUMN F$COPY 80,CRDBUF COPY LINE IMAGE TO OUTPUT LINE F$PRT 1 PRINT THE IMAGE J 0,X5 RETURN TO CALLING SEQUENCE /. . . SCANNER ERROR HANDLERS . BADCMD . . . SEARCH FOR COMMAND ABBREVIATION . if exactcmd=2 te a1,r15 second six characters blank ? j abbnw no. can't be correct endf LNA,U A2 SET MASK TO ALL SIX CHARACTERS LR,U R3,5 LOAD SEARCH LOOP COUNTER ABB1 LR R2,A2 LOAD SEARCH MASK LXM,U X7 CLEAR SEARCH POINTER LR,U R1,CMDTLEN LOAD LENGTH OF COMMAND TABLE MSE A0,CMDTAB,*X7 SEARCH FOR COMMAND UNDER MASK J ABB2 NOT FOUND. RELAX RESTRICTIONS . . FOUND IT. INSURE IT'S NOT AMBIGUOUS . LA,U A3,,X7 SAVE FIRST FIND LOCATION MSE A0,CMDTAB,*X7 SEARCH FOR ANOTHER MATCH J ABB3 O.K. NOT AMBIGUOUS . . AMBIGUOUS. EDIT ERROR MESSAGE . LMJ X5,PRINT PRINT THE COMMAND F$MSG DYM EDIT 'DO YOU MEAN ' LA,U A4,1 INITIALISE NUMBER OF AMBIGUOUS ENTRIES ABB6 F$FD2 CMDTAB-CMDEL,A3 EDIT FIRST AMBIGUOUS ONE F$CHAR ',' EDIT A COMMA AFTER THIS ONE F$SKIP 1 SKIP A SPACE F$COLN . GET COLUMN NUMBER TLE,U A0,52 PAST RIGHT MARGIN ? J ABB4 NO. KEEP ON EDITING F$PRT 1 YES. PRINT THE LINE ABB4 LA,U A3,,X7 SAVE NEWLY FOUND ONE LA A0,COMMAND RESTORE SEARCH KEY MSE A0,CMDTAB,*X7 LOOK FOR MORE AMBIGUOUS COMMANDS J ABB5 NO MORE. EDIT LAST ONE AA,U A4,1 BUMP NUMBER OF AMBIGUITIES FOUND J ABB6 FOUND ONE. APPEND IT TO MESSAGE . ABB5 TG,U A4,2 NEED A COMMA FOR GOOD GRAMMAR ? J ABB7 YES. LEAVE IT THERE F$SKIP -2 BACK UP OVER COMMA F$CHAR ' ' ERASE IT ABB7 F$FD3 ('OR ') EDIT 'OR' BEFORE LAST ONE abb7a F$FD2 CMDTAB-CMDEL,A3 EDIT FINAL COMMAND F$CHAR '?' EDIT FINAL QUESTION MARK JNDEM CHOKE ERROR IF NOT DEMAND TZ FROMADD WAS COMMAND FROM AN ADD FILE ? J CHOKE PRINT ERROR AND KILL COMMAND F$SKIP 1 SKIP A SPACE AFTER QUESTION MARK ON EOL>-1 F$CHAR EOL EDIT LINE TERMINATION OFF EOL>-1 LA,U A0,13 LOAD IMAGE LENGTH SNONZ DATLN,A0 CLEAR DATA LINE JGD A0,$-1 PRIOR TO READ TREAD ASKTRP ASK ABOUT AMBIGUITY E$DITX . GET LOOSE FROM SCAN PACKET E$DITR DLPKT SCAN THE DATA LINE BUNGO E$COL 0 TAB TO FIRST COLUMN LR,U R4,12 LOAD LENGTH TO SCAN F$DT1 2,qual SET UP TO SCAN INTO QUALIFIER U$POS4 . FIND FIRST NON-BLANK JN A0,WDYRM NULL. ASK USER AGAIN ACUMC2 JA A0,ACX2 ACCUMULATE IF ALPHABETIC JNUM A0,ACX2 ...OR IF IT'S NUMERIC . DELIMITER. ACCEPT SCANNED NEW COMMAND DL A0,QUAL LOAD WHAT WE SCANNED TNE A0,R15 ALL BLANK ? J WDYRM YES. ASK HIM AGAIN WITH EMPHASIS te a0,('NO ') is it 'NO' ? TNE A0,('NONE ') IS ANSWER 'NONE' ? J CHUNK YES. IGNORE COMMAND TYPED . . Now we check if the answer is 'YES'. If so, there are two basic . cases. Either there is only one command we're asking the user to . confirm, or else the user is one of those wise guys who answers . 'YES' to every 'or' question. If this is a silly 'YES', we . ask the user to clarify himself. . te a0,('YES ') is the answer 'YES' ? j abbnys no. it must be a command jnz a4,wdyrm re-prompt user if more than one found e$ditx . single command confirmed. e$ditr scnpkt restart the scanner packet j fnabb continue scanning the command . abbnys DS A0,COMMAND PUT NEW COMMAND IN PLACE E$DITX . TERMINATE SCANNING OF DATA LINE E$DITR SCNPKT GET THE SCANNER PACKET BACK J ENDCMD PROCESS SECOND CHANCE COMMAND . ACX2 JGD R4,$+2 SKIP IF MAXIMUM NOT EXCEEDED J IXS2 MAXIMUM REACHED. IGNORE REST F$CHAR . STORE OUT THIS CHARACTER IXS2 U$CHAR . LOAD THE NEXT ONE J ACUMC2 SCAN THE NEXT CHARACTER . WDYRM F$DT1 fll$,fl$ SET UP EDITOR, CLEAR LINE F$MSG WDYMB INQUIRE WHAT USER HAD IN MIND F$FD2 COMMAND FILL IN HIS FUNNY COMMAND F$MSGR . COPY REST OF MESSAGE ON EOL>-1 F$CHAR EOL TERMINATE THE LINE OFF EOL>-1 LA,U A0,13 LOAD LINE LENGTH SNONZ DATLN,A0 CLEAR THE READ LINE JGD A0,$-1 ...ALL OF IT TREAD ASKTRP ASK THE MUSICAL QUESTION... J BUNGO SCAN THE ANSWER . . ABB3 LXM,U X7,,A3 RESTORE POINTER TO FOUND COMMAND if exactcmd=2 lna a2,r2 load mask or characters excluded and a0,a2 mask off command entered and a2,r15 mask word of spaces identically te a1,a3 were dropped characters spaces ? j abbnw no. don't recognize the command endf if exactcmd=1 te a1,r15 second six characters blank ? j abb8 no. don't allow abbreviations lna a2,r2 load mask for characters excluded and a0,a2 yes. mask first word and a2,r15 mask spaces similarly tne a1,a3 were only spaces at end ? endf J FNABB ENTER COMMAND PROCESSING if exactcmd=1 abb8 lmj x5,print print the command if necessary f$msg dym edit 'Do you mean' text la a3,x7 restore pointer to found command la,u a4,0 clear the alternatives found j abb7a go edit in command entered and ask endf . ABB2 LSSL A2,6 MAKE MASK LESS SELECTIVE JGD R3,ABB1 TRY IT AGAIN . . COULDN'T FIND IT. PRINT ERROR MESSAGE . abbnw LMJ X5,PRINT PRINT COMMAND FOR BATCH F$MSG BCMEM EDIT MESSAGE F$FD2 COMMAND EDIT BAD COMMAND F$CHAR '.' END THE MESSAGE J CHOKE JOIN ERROR CODE . BADINT LMJ X5,PRINT PRINT COMMAND FOR BATCH F$MSG MFI EDIT BAD INTEGER MESSAGE J CHOKE PROCESS ERROR . BADDELIM SA A0,BOOBOO SAVE BAD CHARACTER LMJ X5,PRINT PRINT THE COMMAND F$MSG BDEL EDIT MESSAGE FOR BAD DELIMITER F$CHAR BOOBOO,,W EDIT BAD CHARACTER F$MSGR . EDIT REST OF MESSAGE J CHOKE PROCESS ERROR . OMPERR LMJ X5,PRINT PRINT THE BAD COMMAND F$MSG OMPX EDIT MESSAGE FOR MISSING PARAMETER LA A2,PDTYPE,X8 LOAD TYPE OF MISSING PARAMETER TLE,U A2,PARTYNML LARGER THAN TYPES WE KNOW ABOUT ? TNZ,H2 PARTYNM,A2 NO. IS MESSAGE DEFINED FOR THIS TYPE ? J OMPERS NO. DON'T EDIT TYPE IF UNKNOWN F$SKIP 1 SKIP BEFORE EDITING TYPE F$MSG1 PARTYNM,A2,H2 EDIT TYPE OF MISSING PARAMETER OMPERS F$MSGR . COPY REST OF MESSAGE J CHOKE PROCESS ERROR . BADOPT SA A0,BOOBOO SAVE THE BAD CHARACTER LMJ X5,PRINT PRINT THE COMMAND F$MSG ILOPT EDIT BAD OPTION MESSAGE F$CHAR BOOBOO,,W EDIT THE BAD CHARACTER F$MSGR . FINISH MESSAGE J CHOKE PROCESS ERROR . BADFCYC LMJ X5,PRINT PRINT THE COMMAND F$MSG BAFCM EDIT BAD F-CYCLE MESSAGE J CHOKE THAT'S ALL . MIFILE LMJ X5,PRINT PRINT THE COMMAND F$MSG MIFM EDIT MESSAGE J CHOKE END OF THE LINE . SOLLY LMJ X5,PRINT PRINT THE COMMAND F$MSG UNIMC EDIT UMIMPLEMENTED COMMAND MESSAGE F$FD2 CMDTAB+CTNAME,X7 EDIT THE COMMAND NAME F$MSGR . FINISH UP J CHOKE PROCESS THE ERROR . ILLEQP LMJ X5,PRINT PRINT THE COMMAND TZ HADASG DID WE ASSIGN THE FILE ? J ILEQFR YES. GO FREE IT ON USEREL TZ OPTMIS WAS @USE OPTIMISED OUT ? J ILEQNF YES. NO NEED TO @FREE, THEN F$MSG FREECA EDIT @FREE,A IMAGE J ILEQDF GO DO THE @FREE OFF USEREL ILEQFR F$COPY 5,('@FREE ') EDIT '@FREE' IMAGE LA,U A0,',AR' LOAD OPTIONS IF @USE NAME TNZ OPTMIS WAS A @USE NAME ATTACHED ? F$FD1 . YES. RELEASE IT SAFELY F$SKIP 1 SKIP BEFORE FILE NAME ILEQDF F$FD2 INTNAM EDIT FILE NAME INTO @FREE IMAGE LA,U A0,FL$ LOAD IMAGE FOR @FREE LMJ X11,CSF FREE THE FILE AND / OR INTERNAL NAME IERR . BOMB ON FORMAT ERROR F$DT . CLEAR THE LINE ILEQNF . F$MSG ILLEM EDIT ILLEGAL EQUIPMENT TYPE MESSAGE LA,S1 A0,INTNAM+6 LOAD ILLEGAL EQUPIMENT TYPE LA A0,EQTTAB+EPTNAME,A0 LOAD NAME OF EQUIPMENT TYPE SSL A0,12 SHIFT OFF PROPERTY BITS F$FD1 . EDIT BAD EQUIPMENT TYPE IN MESSAGE F$MSGR . COPY SOME MORE TNZ QUAL ANY QUALIFIER ? J ILLQ1 NO. F$FD2 QUAL EDIT QUALIFIER F$CHAR '*' EDIT A STAR ILLQ1 F$FD2 FILENAME EDIT THE FILE NAME F$MSGR . COPY THE REST J CHOKE PRINT THE MESSAGE . USGREJ SA A0,A6 SAVE CSF$ STATUS LMJ X5,PRINT PRINT THE COMMAND LA A0,A6 RELOAD CSF STATUS LMJ X5,CSFSTR EDIT CSF$ STATUS ON USEREL TZ OPTMIS WAS @USE OPTIMISED OUT ? J CHUNK YES. NO @USE NAME TO RELEASE F$MSG FREECA EDIT THE @FREE,A IMAGE F$FD2 INTNAM EDIT THE @USE NAME LA,U A0,FL$ LOAD IMAGE ADDRESS LMJ X11,CSF RELEASE THE INTERNAL NAME IERR . FORMAT ERROR ? NOT VERY LIKELY F$DT . CLEAR THE EDITING LINE OFF USEREL J CHUNK DONE WITH THE STATEMENT . BADTYL SA A0,BOOBOO SAVE BAD CHARACTER LMJ X5,PRINT PRINT THE COMMAND F$MSG BADTYM EDIT BAD TYPE LETTER MESSAGE F$CHAR BOOBOO,,W EDIT OFFENDING CHARACTER F$MSGR . COPY REST OF MESSAGE J CHOKE ERROR OFF COMMAND . BADECYC LMJ X5,PRINT PRINT THE COMMAND F$MSG BADECYM EDIT BAD ELEMENT CYCLE MESSAGE J CHOKE PRINT AND KILL COMMAND . ILTYM LMJ X5,PRINT PRINT THE COMMAND F$MSG ILTYMT EDIT MESSAGE PREFIX F$FD2 EXELTN EDIT USER'S SPECIFICATION F$MSGR . COPY REST OF IT J CHOKE PRINT AND KILL COMMAND . . CHOKE JNDEM PRETR SKIP LINE TERMINATION FOR BATCH F$CHAR EOL TERMINATE THE LINE PRETR F$PRT 1 PRINT THE LINE ICERR* . IMMEDIATE COMMAND ERROR RETURN CHUNK JDEM REJECT GET ANOTHER COMMAND IF DEMAND JOL 'A',REJECT ALLOW CONTINUATION FOR 'A' OPTION J WINDDOWN OTHERWISE WIND UP FOR BATCH PROCESSING . IMPURE CODE IERR* I$ . ENTRY ADDRESS J IERR1 ENTER PROCESSING ROUTINE PURE CODE IERR1 DS A0,,X4 SAVE A0, A1 IN SWITCH LIST F$DT1 fll$,fl$ START EDITOR F$FD3 ('IERR ') LA,H2 A0,IERR LOAD TRAPPED ADDRESS ANA,U A0,1 BACK UP TO ADDRESS OF IERR F$OCTF 6 EDIT THE ADDRESS F$PRT 1 PRINT THE IERR MESSAGE DL A0,,X4 RELOAD A0, A1 EABT$ . WIND UP THIS GAME . . DATA SCANNER ERRORS . DATBAD SA A0,BOOBOO SAVE ILLEGAL CHARACTER F$DT1 fll$,fl$ SET UP EDITOR F$MSG DABEM EDIT MESSAGE F$CHAR BOOBOO,,W FILL IN BAD CHARACTER F$MSGR . FINISH UP J DAERR JOIN COMMON ERROR PROCESSING . MFDI F$DT1 fll$,fl$ SET UP EDITING LINE F$MSG MFI EDIT MESSAGE J DAERR PROCESS ERROR . SRMQ F$DT1 fll$,fl$ SET UP LINE F$MSG SRMQM EDIT MISSING QUOTE MESSAGE J DAERR PROCESS ERROR IN DATA . EXTRAR F$DT1 fll$,fl$ SET UP EDITOR F$MSG EXREM COPY MESSAGE TO LINE J DAERR PROCESS ERROR . MISSIR F$DT1 fll$,fl$ CLEAR THE LINE F$MSG MISSIM EDIT MISSING RIGHT PARENTHESIS MESSAGE J DAERR PROCESS DATA ERROR . BDAI SA A0,BOOBOO SAVE BAD CHARACTER F$DT1 fll$,fl$ SET UP EDITOR F$MSG BDAIM COPY MESSAGE F$CHAR BOOBOO,,W COPY THE ILLEGAL CHARACTER F$MSGR . COPY REST OF MESSAGE J DAERR HANDLE ERROR . VFNY F$DT1 fll$,fl$ CLEAR THE LINE F$MSG VFNYM EDIT THE MESSAGE J DAERR PROCESS THE ERROR . BREPC F$DT1 fll$,fl$ CLEAR THE LINE F$MSG BRECM EDIT BAD REPEAT COUNT MESSAGE J DAERR PROCESS DATA ERROR . NODATA F$DT1 fll$,fl$ SET UP AND CLEAR LINE F$MSG NODAM EDIT NO DATA ERROR MESSAGE J DAERR PROCESS DATA MODE ERROR . CORCER F$DT1 fll$,fl$ CLEAR THE LINE F$MSG CORCEM EDIT 'CORRECTION ERROR'. CORCEN F$PRT 1 PRINT THE MESSAGE SZ CCALR CLEAR CARD ALREADY READ SZ DATAS CLEAR GETTING DATA J DATANC ASK FOR MORE CORRECTIONS . SEQERR F$DT1 fll$,fl$ SET UP EDITOR F$MSG SEQCEM EDIT SEQUENCE ERROR MESSAGE J CORCEN PRINT MESSAGE AND SOLICIT INPUT . . DATA ERROR HANDLER . DAERR JNDEM DARXL APPEND MERCIFUL MESSAGE ? F$SKIP 2 YES. SKIP BEFORE IT F$MSG TRYDAX INFORM OF SECOND CHANCE DARXL F$PRT 1 PRINT EDITED ERROR MESSAGE SZ DATAS CLEAR DATA BEING SCANNED DARIP REMOVE DATAQ REMOVE A QUEUED ITEM TNE,U A1,DATAQ END OF THE LIST ? J DAROE YES. CONTINUE ERROR PROCESSING BRELP A1 RELEASE THE DATA ITEM J DARIP CONTINUE THE GRAND RIPOFF DAROE TZ EOFHIT WAS EOF ENCOUNTERED PREVIOUSLY ? J REJECT YES. ABORT THIS COMMAND AND TERMINATE JDEM REIDC TELL DEMAND USER TO TRY AGAIN JOL 'A',REJECT REJECT STATEMENT IF 'A' OPTION SET J WINDDOWN OTHERWISE, QUIT RIGHT NOW . REIDC J SCNDRS RESTART DATA SCAN . . ABORT PATCH SCAN . ABPAT REMOVE PAQUE REMOVE A PATCH ITEM TNE,U A1,PAQUE END OF LISY ? J ABP1 YES. START FREEING DATA ITEMS BRELP A1 RELEASE THE ITEM TO BREL J ABPAT LOOP BACK ABP1 REMOVE DATAQ RIPOFF A DATA ITEM TNE,U A1,DATAQ THE LAST ONE ? J ABP2 YES. ALL DONE WITH THIS ABORTION BRELP A1 RELEASE THE DATA ITEM J ABP1 LOOP FOR DATA ITEMS ABP2 JNDEM WINDDOWN END OF THE ROAD FOR BATCH F$DT1 fll$,fl$ CLEAR THE LINE F$MSG TRYCAX EDIT THE RE-ENTER MESSAGE F$PRT 1 PRINT THE MESSAGE LA,U A9 CLEAR TOTAL PATCH BUFFER LENGTH LNA,U A8,1 RESET LAST WORD REFERENCED J SCNDRS RESTART CORRECTION SCAN /. . . CHARACTER CLASS TABLES . PURE DATA . CHARGEN* PROC *0 . . THIS PROC DEFINES THE LISTSTRUCTURES USED TO GENERATE THE CHARACTER . CLASS TABLES USED IN THE SCANNER. . . CALL: CLASS,<TABLE ID> <CLASS NO> <CHAR> <CHAR>,<CHAR> ... . . THIS CALL SETS, FOR TABLE <TABLE ID>, THE CHARACTERS AND . CHARACTER RANGES DEFINED TO CLASS <CLASS NO>. . P PROC *2047 CLASS* NAME 0 A(0) EQU P(0,1) GET TABLE NUMBER A(1) EQU P(1,1) GET CLASS NUMBER A(2) EQU P-2 GET NUMBER OF CHAR SPECIFICATIONS W* PROC *0 DO P(I+1)=1 ,B**(A(0),P(I+1,1)) EQU A(1) DO P(I+1)>1 ,; J DO P(I+1,2)-P(I+1,1)+1 ,; B**(A(0),P(I+1,1)+J-1) EQU A(1) END I DO A(2) , W END . CLASS,1 AN 'A','Z' '0','9' '-' '$' CLASS,1 DELIM '*' '.' ' ' ',' '/' '(' . CLASS,2 AN 'A','Z' '0','9' '-' '$' CLASS,2 DELIM '*' ',' ' ' '/' ':' '(' . . CHARACTER CLASS TABLE . . I DO 64 , ; * B(1,I-1),B(2,I-1),B(3,I-1),B(4,I-1),B(5,I-1),B(6,I-1) END . . CHARACTER CLASS TABLE NAMES . FNAME EQUF $,,S1 FILE NAME DELIMITER TABLE . . MAIN CHARACTER CLASS TABLE . CHARCLASS CHARGEN . GENERATE CHARACTER CLASS TABLE /. . . SCANNER DATA . IMPURE DATA CHAR '$',072 . CLOSING* * 0 CLOSING OUT FLAG COMPLETED* PVQUEUE 0 V'D ON COMPLETION WHEN CLOSING SET PARQUE* QUEUE . QUEUE OF SCANNED PARAMETERS CONCUR* PVQUEUE concurrency NUMBER OF OUTSTANDING OPERATIONS TO ALLO OUTSTANDING* * 0 NUMBER OF OUTSTANDING COMMANDS ON INTERSITE LINEACTV* * 0 ACTIVE COMMUNICATION LINE COUNT ICHGLOCK* PVQUEUE 1 INTERCHANGE PROCESSING LOCK ICHWORK* PVQUEUE 0 INTERCHANGE TRANSACTION AVAILABLE ICHWQ* QUEUE . INTERCHANGE TRANSACTION QUEUE OFF INTERSITE LOOKAHEAD* * 3 NUMBER OF BUFFERS TO GET AHEAD TRDEPK * 0102,LINE TREAD$ PACKET IN DBANK FOR AXWDCK * WINDDOWN,CRDBUF SECOND WORD OF TREAD$ PACKET DATATR * 0102,LINE TREAD$ PACKET FOR DATA READ * DATEOF,DATLN TREAD$ PACKET FOR DATA (WORD 2) ASKTRP * 0126,FL$ PACKET TO REQUEST CLARIFICATION * WINDDOWN,DATLN ...FROM USER FOR AMBIGUOUS COMMAND . TYPOUTST* * 0 TYPE AND READ OUTSTANDING FLAG . COMMAND RES 2 CURRENT COMMAND IMAGE CWOPTION* * 0 CURRENT OPTIONS IMPLOPT* * 0 IMPLIED COMMAND OPTIONS CWREPEAT EQUF $,,S1 THIS COMMAND IS REPEAT MODE CWPARS EQUF $,,S2 NUMBER OF PARAMETERS TO SCAN HADASG EQUF $,,S3 HAD TO ASSIGN FILE FLAG (FOR FREE) OPTMIS EQUF $,,S4 OPTIMISED OUT @USE, NO INTERNAL NAME LWLP EQUF $,,S5 LAST WAS LEFT PARENTHESIS CCALR EQUF $,,S6 CORRECTION CARD ALREADY READ * 0,0,0,0,0,0 . PAMODE EQUF $,,S1 ACCUMULATING PATCH MODE MAMODE EQUF $,,S2 ACCUMULATING MASK MODE DATAS EQUF $,,S3 DATA IS BEING ACCUMULATED FLAG EOFHIT EQUF $,,S4 EOF HIT. DON'T READ ANY MORE ZIMPLE EQUF $,,S5 NOTHING ACTUALLY SCANNED FLAG BOOBOO EQUF $,,S6 BAD CHARACTER SAVE * 0,0,0,0,0,0 CSAVE * 0 CONTINGENCY A0 SAVE CWDOLEV EQUF $,,H1 CURRENT 'DO' LEVEL CWDOCHN EQUF $,,H2 CHAIN OF SAVED STATEMENTS * 0,0 CWPATCH EQUF $,,H1 CURRENT PATCH BUFFER CWMASK EQUF $,,H2 CURRENT MASK BUFFER * 0,0 STKDEPTH EQUF $,,H1 MAXIMUM STACK DEPTH NEEDED PARLEV EQUF $,,H2 PARENTHESIS LEVEL * 0,0 . . FILE SCAN BUFFERS . QUAL RES 2 FILENAME RES 2 FCYCLE RES 1 RKEY RES 1 WKEY RES 1 INTNAM RES 2 RES 9 FOR FITEM$ . . ELEMENT SCAN BUFFERS . EXELTN EQU QUAL ELEMENT NAME EXVERN EQU FILENAME VERSION NAME EXALL EQUF FCYCLE,,S1 TYPE SELECTION BITS EXFDT EQUF FCYCLE,,H2 FDT ASSOCIATION EXCYC EQU RKEY CYCLE SPECIFICATION EXTBIT EQUF WKEY TYPE SELECTION BITS FANGINT EQUF $,,H1 INTERNAL NAME SEQUENCE NUMBER FDLIST EQUF $,,H2 HEAD OF FDT LIST FDCHAIN* * 0,0 BKLIST EQUF $,,H2 HEAD OF BLOCK LIST ELTFLG EQUF $,,S3 ELEMENT BEING SCANNED FLAG CLASGO EQUF $,,S2 CLASS SCANNED FOR ELEMENT FROMADD EQUF $,,S1 NONZERO IF IMAGE IS FROM ADD FILE BKLWD* * 0,0 . LASFDT EQUF $,,H1 LAST FDT USED FOR AN ELEMENT PRINTYET EQUF $,,S4 IMAGE PRINTED YET FLAG FOR BATCH FCSIGN EQUF $,,S5 SIGN FOR F-CYCLE SPECIFIED . EQUF $,,S6 * FREE * * 0,010000 . . INTERFACE STORAGE TO DISPATCHER . CMDLOCK* PVQUEUE 1 COMMAND QUEUE LOCK FISTAT* PVQUEUE 1 LOCK ON FACILITY STATUS CMDQUE* QUEUE . QUEUE OF UNPROCESSED COMMANDS INPROCQ* QUEUE . QUEUE OF IN-PROCESS COMMANDS HAPPEN* PVQUEUE 0 DISPATCHER WAITS HERE FOR THINGS . TO IMPROVE PRINTER* PVQUEUE 1 LOCKS THE PRINTER FOR LONG OUTPUTS PRINTX* PVQUEUE 0 DUMP COMPLETION QUEUE DATAQ QUEUE . QUEUE OF DATA ITEMS PAQUE QUEUE . QUEUE OF PATCH PARAMETER BUFFERS . PURE DATA ITYPE EQUF $,,S3 TYPE CODE FOR THIS EQUIPMENT ITBL EQUF $,,H2 ASSUMED BLOCK LENGTH FOR THIS EQUIPMENT * TSINGLE,2000 TAPE * TSINGLE,2000 TAPE * FWAD,32 WORD ADDRESSABLE DRUM * FFAST,28 FASTRAND FORMAT STORAGE . . EDITING STORAGE . IMPURE DATA LINE* RES 22 VALBUF RES 14 VALUES SCANNED FROM DATA DATLN RES 14 DATA READ BUFFER LINENO EQUF $,,H1 CURRENT LINE NUMBER SASLN EQUF $,,H2 LINE NUMBER STATEMENT FOUND ON * 0,0 CRDBUF RES 14 SCNPKT E$PKT 14,CRDBUF DLPKT E$PKT 14,DATLN. PACKET TO SCAN DATA PURE DATA FREECA '@FREE,A &' ASGAX '@ASG,AX !' DATELL 'DATA &' KETELL 'SEARCH KEY&' PATELL 'CORRECTION&' MATELL 'MASK &' . . PARAMETER TYPE NAMES . PTN(0) 'NUMBER&' PTN(1) 'FILE NAME&' PTN(2) 'STRING&' PTN(3) 'DATA&' PTN(4) 'KEY&' PTN(5) 'BLOCK NAME&' PTN(6) 'INTERNAL BLOCK&' PTN(7) 'ELEMENT NAME&' PTN(8) 'ELEMENT CLASS&' PTN(9) EQU PTN(8) PTN(10) 'ELEMENT TYPE&' . PARTYNM . I DO PTN , * 0,PTN(I-1) PARTYNML EQU $-PARTYNM . . ERROR MESSAGES . BCMEM 'STRANGE COMMAND, &' DYM 'DO YOU MEAN &' WDYMB 'WHAT COMMAND DID YOU MEAN WHEN YOU SAID $&$? &' MFI 'MALFORMED INTEGER.&' BDEL 'STRANGE DELIMITER, $&$.&' OMPX 'MISSING& PARAMETER.&' ILOPT 'STRANGE OPTION, $&$.&' BAFCM 'BAD F-CYCLE SPECIFICATION.&' MIFM 'MISSING FILE NAME.&' BADTYM '$&$ IS AN ILLEGAL CHARACTER IN AN ELEMENT TYPE PARAMETER.&' BADECYM 'MALFORMED ELEMENT CYCLE.&' ILTYMT 'STRANGE TYPE SPECIFICATION, &.&' UNIMC 'SORRY, & IS NOT IMPLEMENTED YET.&' ILLEM 'ILLEGAL EQUIPMENT TYPE & FOR FILE &.&' DABEM 'ILLEGAL CHARACTER $&$.&' SRMQM 'MISSING QUOTE.&' EXREM 'EXTRA RIGHT PARENTHESIS.&' MISSIM 'MISSING RIGHT PARENTHESIS.&' BDAIM 'ILLEGAL DELIMETER $&$ AFTER ITEM.&' VFNYM 'VERY FUNNY.&' BRECM 'BAD REPEAT COUNT.&' NODAM 'NO DATA SUPPLIED.&' CORCEM 'BAD CORRECTION FORMAT.&' SEQCEM 'CORRECTION OUT OF SEQUENCE.&' TRYDAX 'RE-ENTER DATA.&' TRYCAX 'RE-ENTER CORRECTIONS.&' END