.
. 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