TITLE VETRC ;THIS PROGRAM VETS THE INPUT FIELD SPECIFICATION ;AND CONSTRUCTS THE INTERNAL RECORD ; ; ; ; JOHN KAY DEC UK ; EDITNO==:1 ;EDIT NO VERSION==:1 ;MAJOR VERSION NO; VMINOR==:0 ;MINOR VERSION NO; VWHO==:0 ;WHO LAST EDITED JOBVER==:137 ;LOC OF VERSION IN JOB DATA AREA %VERS==: ENTRY RECCK,RECRIT,RECRED,OUTIO EXTERN .JBFF ENTRY VETRC,GENREC,DVALUE,INITIO,OVALUE,CLOS P=17 AC=3 ER=AC+1 B=ER+1 C=B+1 D=C+1 E=D+1 F=E+1 G=F+1 ;INDEXING BRICK H=G+1 ;*************************************************** ;*************************************************** ; ;TRANSFER FILENAME AND INITIALISE ;OUTPUT FILE ; INITIO: PUSHJ P,FILMOV ;MOVE FILENAME JRST CALLR FILMOV: MOVE AC,1(16) MOVEM AC,ERRNO ;ERROR NO MOVE AC,@(16) ;FILENAME BYTE POINTER HRRZI C,7 ;LOOP COUNT SETZ ER, ;CLEAR ERROR SETZM EEE ;CLEAR FILE NAME AREA MOVE D,EPT ;GET BYTE POINTER ENXT: ILDB B,AC ;GET CHAR CAIN B,16 ;IS IT FULL STOP JRST EXTM ;YES GET EXT IDPB B,D ; SOJN C,ENXT JUMPA ERRS1 ; EXTM: HRRZI C,3 ;MOVE EXTENSION MOVE D,EPTA ;GET BYTE POINTER EXTMA: ILDB B,AC ;THREE WORDS IDPB B,D SOJN C,EXTMA POPJ P, ;END OF SRTN CALLR: CALL [SIXBIT/RESET/] ;INIT IO POPJ P, ;EXIT ;**************************************************** ;**************************************************** ; ;INITIAISE AND SET UP OUTPUT FOR DATA RECORDS ; ; OUTIO: MOVE AC,@(16) ;SIXBIT MOVEM AC,SIXB MOVEI AC,10 ;SET UP OUTPUT TYPE SKIPN SIXB ;IS IT SIXBIT HRRM AC,.+1 ;YES INIT 3,0 ;INIT FILE SIXBIT /DSK/ XWD OBUF, JRST E1 ;ERROR MOVEI AC,ABC MOVEM AC,.JBFF OUTBUF 3,2 ENTER 3,EEE ;SELECT FILE JRST E2 ;ERROR POPJ P, ;EXIT ; ; ;CHECK FOR UNIQUENESS OF RECORD IDENTIFIER ; RECCK: MOVE AC,@(16) ;START OF INT REC LAYOUT MOVEM AC,BRICK MOVE AC,@1(16) ;REC ID MOVEM AC,RECID MOVE AC,2(16) HRRZM AC,N ;ADDR OF N SETZ ER, ;CLEAR ERROR FLAG MOVE C,@N ;COUNT FOR LOOP MOVE B,[-1] RNR: SOJE C,RECEN ;END OF AREA AOS BRICK ;WORD WITH REC ID LDB AC,PTI CAMN AC,RECID ;SAME ID JRST ERRS1 ;YES NO GOOD RNEXT: AOS BRICK ;NEXT WORD SOJE C,RECEN ;END OF AREA CAME B,@BRICK ;START OF RECORD JRST RNEXT ;NEXT WORD JRST RNR ;NEXT RECORD RECEN: SETZM POINT ;CLEAR OVERLAP POINTER POPJ P, ;END OF SEARCH ;*************************************************** ;*************************************************** ; ; ; VET THE INPUT -FIELD LAYOUTS- OF THIS RECORD ; VETRC: MOVE AC,@(16) ;FIRST PARAM MOVEM AC,PA ;STORE BYTE POINTER MOVE AC,@1(16) ;INTERNAL BUFFER MOVEM AC,BRICK ;OUTPUT AREA MOVE AC,2(16) ;N MOVEM AC,N ;POINTER TO NEXT WORD IN OUTPUT WORD MOVE AC,@3(16) ;SIXBIT MOVEM AC,SIXB ; ;INITIALISE OUTPUT ; SETZ ER, ;CLEAR ERROR MARKER REG MOVE AC,@N ;CONTENTS OF INC SOJ AC, ADDM AC,BRICK ;UPDATE CURRENT POINTER ; ;FIND FIRST TAB IN INPUT BUFFER -THE END OF ;THE FIELD DESCRIPTION ; TABS: ILDB AC,PA ;NEXT BYTE CAIE AC,11 ;IS IT TAB JUMPA TABS ;NO ; ;VALIDATE THE FIELD TYPE AND STORE APPROPRIATE ;FIELD TYPE IN INTERNAL RECORD ;VALID TYPES ARE - A,X,N,C,F ; ILDB AC,PA ;NEXT INPUT BYTE- FIELD TYPE SETZ B, CAIN AC,101 ;IS IT A AOJA B,.+2 ;YES TYPE 5 CAIN AC,130 ;IS IT X AOJA B,.+2 ;YES TYPE 4 CAIN AC,116 ;IS IT N AOJA B,.+2 ;YES TYPE 3 CAIN AC,103 ;IS IT C AOJA B,.+2 ;YES TYPE 2 CAIN AC,106 ;IS IT F AOJA B,.+2 ;YES TYPE 1 JUMPA ERRS2 ;NO MOVE E,B ;PRESERVE TYPE DPB B,PTA ;PUT MARK IN BRICK ILDB AC,PA ;NEXT INPUT BYTE-TAB CAIE AC,11 ;IS IT JUMPA ERRS2 ;NO HARD LUCK ; ;VALIDATE INPUT METHOD AND STORE INTERNAL ;REPRESENTATION IN INTERNAL AREA ;VALID TYPES ARE - P THRU W INC ; ILDB AC,PA ;NEXT BYTE -INPUT METHOD ;BETWEEN P-W INC MOVEI B,10 ;LOOP COUNT MOVEI C,117 ;START VALUE INM: AOJ C, CAME AC,C ;IS CHAR OK SOJG B,INM ;NO TRY NEXT SOJL B,ERRS3 ;FAIL IF COUNT LT 0 DPB B,PTB ;PUT MARK IN BRICK ILDB AC,PA ;NEXT BYTE -TAB CAIE AC,11 ;IS IT JUMPA ERRS3 ;NO ; ;VALIDATE CHARACTER POSITION AND CONVERT TO ;BINARY IF OK STORE IN INTERNAL RECORD ; PUSHJ P,CONV ;CONVERT CH POS FROM DEC JUMPA ERRS4 ;NO GOOD MOVE C,POINT ;END OF LAST FIELD CAMGE B,C ;IS IT OK JUMPA ERRS5 ;FIELDS OVERLAP CAIN B,0 ;IS START POS 0 JRST ERRS4 ;NO MOVE D,B ;PRESERVE ST POS CAIL E,3 ;TYPE LS 3 JUMPA STOK ;NO -START OK MOVE C,SIXB ;YES JUMPN C,ERRS6 ;BIN FIELD IN ASCII REC ADDI B,5 ;FIRST CHAR IN POS 1 IDIVI B,6 ;FULL WORD ALIGNED JUMPN C,ERRS7 ;REM -NO GOOD STOK: DPB D,PTC ;STORE START POSN ; ;VALIDATE FIELD LENGTH ;AND STORE IN INTERNAL RECORD ; PUSHJ P,CONV ;FIELD LENGTH OK JUMPA ERRS8 ;NO GOOD CAIL E,3 ;TYPE 1 OR 2 JUMPA STFL ;NO CAIN B,6 ;IS FIELD LENGTH 6 JUMPA STFL ;YES ITS OK CAIE E,2 ;IS TYPE 2 JUMPA ERRS8 ;NO- FIELD LENGTH BAD CAIE B,12 ;IS FIELD LENGTH 12 JUMPA ERRS8 JRST ERRS12 ;DOUBLE LENGTH NOT IMPL STFL: MOVE F,B ;PRESERVE LENGTH DPB B,PTD ;STORE FIELD LENGTH ; ;VALIDATE INITIAL VALUE ;STORE INTERNALLY IF PRESENT ; MOVE G,BRICK ;SET UP BYTE POINTER PUSHJ P,INIT ;CHECK INIT VALUE JUMPA ERRS9 ;INIT VALUE NO GOOD JUMPA INCN ;NO INC ILDB AC,PA ;INCREMENT CAIE AC,40 ;IS FIRST CH SP JUMPA INCVT ;NO LDB B,PTB ;INPUT FORM SETZ AC, ;INC ZERO CAIN B,1 ;IS IT V MOVEI AC,1 ;YES PROVIDE DEFAULT INC DPB AC,PTF ;SET ZERO INC JUMPA INCN ; ; ;VALIDATE INCREMENT IF PRESENT ;AND STORE INTERNALLY ; INCVT: PUSHJ P,CONV+1 ;VET INC JUMPA ERRS10 ;INC NO GOOD DPB B,PTF ;PUT INC IN PLACE INCN: AOS @N ;INC POINTER N LDB D,PTD ;LENGTH LDB C,PTC ;START ADDR ADD D,C MOVEM D,POINT ;RESET OVERLAP POINTER EXT: POPJ P, ;EXIT ; ; ;THIS SECTION VETS THE INITIAL VALUE ;OF THIS FIELD IF ONE IS GIVEN ;NO INITIAL VALUE IS RECOGNISED BY A FIELD OF SPACES ; INIT: SETZ D, ;CLEAR BLANK FIELD MARKER AOS G SETZ AC, ; DPB AC,PTE ;SET NO INIT VALUE ILDB AC,PA ;GET FIRST CHAR CAIN AC,11 ;IS IT A TAB ; ;ALTHOUGH THERE IS NO INITIAL VALUE THERE MAY BE ;AN INCREMENT ; JRST NOINIT ;NO FIELD CAIG E,2 ;TYPE 3,4,5 JRST TYP12 ;NO TYPE 1 OR 2 MOVE C,SIXB ;SIXBIT MARKER MOVE B,PTH ;SIXBIT BYTE POINTER SKIPE SIXB ;SIXBIT? MOVE B,PTG ;NO CAIE AC,40 ;IS IT A SPACE JRST CHTST ;NO CAIE E,3 ;IS FIELD NUMERIC JRST CHAROK ;NO JRST NOINIT ;NO INITIAL VALUE ;AND END OF INPUT CHTST: MOVEI D,1 ;FIELD NOT ALL SPACES CAIN E,4 ;TYPE = 4 JRST CHAROK ;YES ANY CHAR OK CAIN E,5 ;TYPE = 5 JRST TYP5 ;YES PUSHJ P,NUMR ;TYPE = 3 JRST EXTZ ;NUMBER INVALID JRST CHAROK ;VALID CHARACTER TYP5: PUSHJ P,ALPHA ;TEST ALPHACHAR JRST EXTZ ;LETTER INVALID ; ;AT THIS POINT THE INPUT CHARACTER IS ;OK AND CAN BE STORED IN THE INTERNAL ;RECORD ; CHAROK: JUMPN C,NXTCH PUSHJ P,SIXCT ;CONVERT TO SIXBIT CHAR JRST EXTZ ;NO GOOD NXTCH: IDPB AC,B ;STORE BYTE ILDB AC,PA ;NEXT CHARACTER SOJL F,ERRIN ;TOO LONG CAIN AC,11 ;IS IT TAB JRST EXTIN ;END WITH VALID FIELD CAIE AC,40 ;IS IT SPACE JRST CHTST ;NO CAIN F,0 ;VALID FIELD END WITH SPACES JUMPE D,NOINIT ;ALL SPACES JUMPE F,EXTIN CAIE E,3 ;NUMERIC FIELD JRST CHAROK ;NO JUMPE F,EXTIN ;SPACE OK AT END JRST EXTZ ;NO GOOD IN MIDDLE ; ;TO REACH THIS POINT TOO MANY CHARACTERS ;HAVE BEEN VETTED- EITHER ;FIELD ALL SPACES - NO INIT VALUE ;OR INPUT TOO LONG - HARD LUCK ; ERRIN: JUMPE D,NOINIT ;ALL SPACES JRST EXTZ ;INPUT TOO LONG ; ;EXIT SECTION ; EXTIN: MOVEI AC,1 ;INIT VALUE- YES DPB AC,PTE ;SET MARKER PUSHJ P,CLENGT UPP: ADDM B,@N ;N+SIZE OF INIT FIELD EXTZB: AOS (P) ;GOOD EXIT-EXPECT INC EXTZA: AOS (P) ;END OF INPUT EXTZ: POPJ P, ;NO GOOD ; ;NO INITIAL VALUE PROVIDED BY THE USER ;SO THE PROGRAM MUST CONSTRUCT ONE ; NOINIT: LDB AC,PTB ;INPUT FORM CAIE AC,7 ;IS IT P CAIN AC,0 ;OR IS IT W JRST EXTZB ;YES -DONT NEED INITIAL VAL LDB E,PTA ;TYPE MOVE B,PTH ;CORRECT BYTE POINTER; SKIPE SIXB MOVE B,PTG LDB C,PTD ;LENGTH (LOOP COUNT) CAIG AC,2 ;IS IT U OR V JRST RANLOP ;YES -RANDOM VALUES SETZ AC, ;NO -Q,R,S,T CAIG E,2 ;TYPES 1 OR 2 JRST SPIN CAIN E,3 ;IS IT A NUM ADDI AC,20 ;YES MAKE NUMBER ZERO SKIPE SIXB ;IS IT ASCII ADDI AC,40 ;YES SPIN: IDPB AC,B ;STORE CHARACTER SOJN C,SPIN ;NEXT ONE? JRST EXTIN ; RANLOP: PUSHJ P,GNXT ;GET A RANDOM CHAR IDPB AC,B ;STORE IN INITIAL VALUE SOJN C,RANLOP ;NEXT ONE? JRST EXTIN ; ;THIS SECTION FOR TYPES 1 AND 2 ONLY ; TYP12: PUSHJ P,COMP1 CAIN AC,40 ;FIRST CHAR A SPACE JRST NOINIT ;YES NO INIT VALUE CAIE E,2 ;IS IT TYPE 2 JRST TYP1 ;NO -FLOATING POINT PUSHJ P,CHL ;CONVERT TO BINARY JRST EXTZ ;NO GOOD CAIN D,1 MOVN B, ;MAKE NEGATIVE MOVE E,PTN ;BYTE POINTER IDPB B,E ;STORE WORD JRST EXTIN ; ;FLOATING POINT ONE WORD TYP1: JRST ERRS11 ;NOT IN YET COMP1: CAIE AC,55 ;IS IT MINUS JRST TPLUS ;NO MOVEI D,1 ;SET NEGATIVE MARKER JRST TNEXT TPLUS: SETZ D, ;CLEAR MINUS MARKER CAIN AC,53 ;IS IT PLUS TNEXT: ILDB AC,PA ;NEXT BYTE TNEXTA: SETZ B, ;CLEAR TOTAL MOVEI C,12 ;COUNT FOR CONVERT POPJ P, ;EXIT ; ;SUBR - TEST VALIDITY OF N TYPE FIELD CHARS ; NUMR: CAIN AC,53 ;IS IT A PLUS JRST NUMRA ;YES CAIN AC,55 ;MINUS SIGN JRST NUMRA ;YES NUMRD: CAIGE AC,60 ;VALID DIGIT JRST NUMRB ;NO CAILE AC,71 ; JRST NUMRB ; NUMRA: AOS (P) ;GOOD EXIT NUMRB: POPJ P, ; ; ;CHECK VALIDITY OF ALPHA CHARACTERS - SRTN ; ALPHA: CAIN AC,40 ;IS CHAR A SPACE JRST ALPHAA ;YES CAIGE AC,101 ;GE A JRST ALPHAB ;NO CAILE AC,132 ;LE Z JRST ALPHAB ; ALPHAA: AOS (P) ;GOOD EXIT ALPHAB: POPJ P, ; ; ;SRTN- CONVERT DEC FIELD TO BINARY ; CONV: ILDB AC,PA ;CHAR SETZ B, ;CLEAR ACC MOVEI C,7 ;LOOP COUNT CHL: CAIGE AC,60 ;GE 0 JRST EXTB ;OUT OF RANGE CAILE AC,71 ;LE 9 JRST EXTB ;OUT OF RANGE IMULI B,12 ;MULT BY 10 SUBI AC,60 ;ASCII TO BINARY ADD B,AC ;ADD IN NEW CHAR ILDB AC,PA ; CAIN AC,11 ;IS IT TAB JRST EXTA ;YES CAIN AC,40 ;IS IT A SPACE JRST EXTA ;(FOR END OF INC) SOJG C,CHL ;NO IS FIELD TOO LONG JRST EXTB ;TOO LONG EXTA: AOS (P) ;UPDATE TOP OF STACK EXTB: POPJ P, ;ERRORS ST OUT ; ; ERRS12: ADDI ER,1 ERRS11: ADDI ER,1 ERRS10: ADDI ER,1 ERRS9: ADDI ER,1 ERRS8: ADDI ER,1 ERRS7: ADDI ER,1 ERRS6: ADDI ER,1 ERRS5: ADDI ER,1 ERRS4: ADDI ER,1 ERRS3: ADDI ER,1 ERRS2: ADDI ER,1 ERRS1: ADDI ER,1 MOVEM ER,@ERRNO POPJ P, ;EXIT ; ; PA: 0 ;BYTE POINTER INPUT TO VET -INRECF(M) BRICK: 0 ;INTERNAL AREA ADDR N: 0 ;COUNTER FOR COBOL USE ERRNO: 0 ;ERROR NO PTA: POINT 3,@BRICK,2 PTB: POINT 3,@BRICK,5 PTC: POINT 13,@BRICK,18 PTD: POINT 10,@BRICK,28 PTE: POINT 1,@BRICK,29 PTF: POINT 6,@BRICK,35 PTG: POINT 7,(G) ;ASCII FOR INIT VALUE PTH: POINT 6,(G) ;SIXBIT PTN: POINT 36,(G) ;DEPOSIT WORD SIXB: 0 ;SIXBIT MARKER POINT: 0 ;POSITION IN REC INDIC ; ;OUTPUT WORK AREAS AND ERROR ROUTINES ; EPT: POINT 6,EEE EPTA: POINT 6,EEE+1 ABC: BLOCK 406 ;BUFFERS OBUF: BLOCK 3 ;OUTPUT BUFFER RING EEE: SIXBIT/OUTPUT/ 0 0 0 E1: MOVEI ER,20 JRST E3A E2: MOVEI ER,21 JRST E3A E3: MOVEI ER,22 E3A: MOVEM ER,@ERRNO POPJ P, ;*************************************************** ;*************************************************** ; ;THIS SECTION CONDUCTS THE DIALOG WITH THE USER ;TO GENERATE THE OUTPUT RECORD HE DESIRES ; GENREC: MOVE AC,@(16) ;TRANSFER PARAMETERS MOVEM AC,BRICK ;START OF INT REC DESC MOVE AC,@1(16) ;RECID MOVEM AC,RECID MOVE AC,@2(16) ;PROMPT MESSAGE AREA MOVEM AC,DPROMT MOVE AC,@3(16) ILDB AC,AC ;GET FIELD SEP MOVEM AC,FSEP ;STORE MOVE AC,@4(16) ;USER INPUT AREA MOVEM AC,PA ;STORE BYTE POINTER HRRZ AC,DPROMT MOVEM AC,ENDBUF ;STORE END OF BUFFER MOVE AC,5(16) MOVEM AC,PROMM ;STORE INDICATOR SETZ ER, ;CLEAR ERROR FLAG ; ;SEARCH FOR CORRECT INTERNAL RECORD SPECIFICATION ; MOVE B,[-1] ; JRST GNEXT GRECC: CAMN AC,RECID ;CORRECT ID JRST GFOUND ;YES GNEXT: AOS BRICK ;POINT TO NEXT WORD CAME B,@BRICK ;START OF RECORD JRST GNEXT ;NO AOS BRICK ;NEXT WORD LDB AC,PTI ;CHECK FOR END OF TABLE CAIN AC,77 ;IS IT END JRST ERRS1 ;YES JRST GRECC ;NO ; ;HERE THE CORRECT RECORD ID HAS BEEN FOUND ;NOW FILL OUTPUT AREA WITH FILLERS ; GFOUND: LDB AC,PTJ ;FILLER CHAR SKIPE SIXB ;IS IT SIXBIT ADDI AC,40 ;CONVERT CHAR TO ASCII LDB B,PTK ;RECORD LENGTH MOVEM B,ORECL ;SAVE FOR OUTPUT MOVE C,OPTB ;SELECT CORRECT BYTE POINTER SKIPN SIXB ;SIXBIT MOVE C,OPTA ;YES GNEXTA: IDPB AC,C ;FILL REC WITH FILLERS SOJN B,GNEXTA ;LAST ONE? ; ;OUTPUT RECORD BUFFER FILLED WITH FILLER ;CHARACTER NOW SET UP PROMPT MESSAGE ;IF LAST FIELD SPEC OUTPUT RECORD ; GPROMT: AOS BRICK ;INC INTERNAL POINTER MOVE B,[-1] ;HIGH VALUES CAMN B,@BRICK ;NEXT WORD END JRST GOUTPT ;YES OUTPUT RECORD MOVE AC,@BRICK ;FIELD DESCRIPTION MOVEM AC,@DPROMT ;MOVE TO PROMPT AOS DPROMT ;SET UP POINTERS AOS BRICK ; LDB B,PTC ;LOAD START POSN SETZ AC, ;CLEAR COUNT SETZ E, ;CLEAR TOTAL GDEC: IDIVI B,12 ;CONVERT TO DEC PUSH P,C ;SAVE REMAINDER AOJ AC, ;INC AC SKIPE B ;ALL DIGITS FORMED PUSHJ P,GDEC ;NO COMPUTE NEXT GDEC1: POP P,B ;TAKE OUT CHARACTER ADDI B,20 ;CONVERT TO SIXBIT ADD E,B ;ADD IN NEW CHAR SOJE AC,GSTFN ;LAST ONE LSH E,6 ;NO SHIFT UP POPJ P,GDEC1 ;GET NEXT CHAR GSTFN: HRRZI B,3 ;LOOP COUNT GSHIFT: CAIG E,400000 ;LEFT JUSTIFY NO LSH E,6 ;MOVE ONE PLACE SOJG B,GSHIFT ;AGAIN HRLI AC,4300 ;CONSTANT OF C ADD E,AC ;ADD IN TO START POS MOVEM E,@DPROMT ;STORE IN PROMPT AOS DPROMT ;UPDATE PROMPT POINTER LDB AC,PTA ;INPUT TYPE CAIN AC,1 ;IS IT TYPE 1 HRRZI B,46 ;YES F CAIN AC,2 ;IS IT TYPE 2 HRRZI B,43 ;YES C CAIN AC,3 ;IS IT TYPE 3 HRRZI B,56 ;YES N CAIN AC,4 ;IS IT TYPE 4 HRRZI B,70 ;YES X CAIN AC,5 ;IS IT TYPE 5 HRRZI B,41 ;YES A LSH B,30 ;SHIFT TO POSITION ADDI B,320000 ;MOVE IN : MOVEM B,@DPROMT ;STORE IN PROMPT SOS DPROMT SOS DPROMT ; ;THE PROMPT MESSAGE IS NOW SET UP IN TOTAL ;NOW CHECK WHETHER OR NOT IT IS REQUIRED ;AT THIS STAGE OR WHETHER USER HAS ALREADY ;SUPPLIED INPUT FOR THIS FIELD ; LDB B,PTB ;INPUT FORM CAIG B,2 ;IS IT P-T JRST GNOUS ;NO USER VALUE POSS MOVE B,FSEP ;YES GET FIELD SEP CAIN B,177 ;IS IT CR POPJ P, ;YES EXIT PUSHJ P,GEMPTY ;NO-ANY MORE DATA JRST ANYIN JRST DVAL2 ;DATA IN BUFFER ANYIN: MOVE AC,@PROMM SOSE AC POPJ P, JRST GNOUS ; ;ENTRY POINT AFTER USER HAS TYPED IN A VALUE ;OR A CARRIAGE RETURN OR A VALUE IS ALREADY IN ;THE INPUT BUFFER ; DVALUE: MOVE AC,@(16) ;RESET INPUT BYTE POINTER MOVEM AC,PA MOVE AC,@1(16) ;PROMPT AREA MOVEM AC,DPROMT HRRZI AC,1 MOVEM AC,@PROMM ;PROMPT SENT MARK=1 SETZ ER, ;SET ERROR MARKER ZERO DVAL2: PUSHJ P,GEMPTY ;HAS USER PUT IN A VALUE JRST GNOUS ;NO USER VALUE MOVE B,FSEP ;GET FIELD SEP PUSHJ P,DRANGE ;GET NEXT VALUE -RANGE CHECK JRST ERRS2 ;NO GOOD LDB D,PTB ;GET INPUT METHOD CAIE D,3 ;IS IT T JRST DVAL3 ;NO TRANSFER REQ ; ;TRANSFER USERS INPUT VALUE TO INTERNAL RECORD ;FOR NEXT TIME USE IF TYPE T ; DVAL4: MOVE D,PTH ;SELECT CORRECT BYTE POINTER SKIPE SIXB MOVE D,PTG MOVE G,BRICK ;SET POINTER TO INIT VALUE AOS G PUSHJ P,PNTPOS ;POSITION OUTPUT POINTERS LDB E,PTD ;LENGTHD DVAL5: ILDB AC,C ;GET FROM OUTPUT REC IDPB AC,D ;PLACE IN INIT VALUE SOJN E,DVAL5 ;NEXT BYTE ; ;THE OUTPUT RECORD VALUE FOR THIS FIELD HAS ;BEEN SET UP OK - GO AND SEND USER PROMPT ; DVAL3: SETZ B, ;CLEAR COUNT LDB AC,PTE ;IS INIT VALUE PRESENT SKIPE AC ; PUSHJ P,CLENGT ;YES CALC LENGTH ADDM B,BRICK ;LENGTH OF INIT VALUE SETZ AC, ;CLEAR PROMPT SENT MOVEM AC,@PROMM JRST GPROMT ;GET NEXT FIELD ; ;THIS SECTION IS ENTERED IF THE USER HAS ;NOT INPUT ANY VALUE - THEREFORE THE ROUTINE ;WILL GENERATE A SUITABLE ONE ; GNOUS: LDB B,PTB ;INPUT FORM CAIN B,5 ;IS INPUT FORM R JRST ADDINC ;YES CAIN B,3 ;IS INPUT FORM T JRST ADDINC ;YES CAIE B,1 ;IS INPUT FORM V JRST NOINC ;NO -NO INC REQUIRED ADDINC: PUSHJ P,AINCR ;ADD INC AND RANGE CHECK NOINC: SKIPE @PROMM ;HAS PROMPT BEEN SENT JRST OVALUE ;YES HRRZI AC,2 ;SET PROMM =2 MOVEM AC,@PROMM POPJ P, ;SEND MESSAGE ; ;INPUT POINT IF NO USER VALUE ;IS ALLOWED ; OVALUE: MOVE AC,ENDBUF MOVEM AC,DPROMT SETZ ER, LDB B,PTB ;INPUT FORM CAIN B,0 ;IS INPUT FORM W JRST GRANM ;YES CAIN B,4 ;IS INPUT FORM S JRST GRANM ;YES CAIN B,7 ;IS INPUT FORM P JRST ERRS3 ;YES -USER MUST INPUT A VALUE JRST MVINIT ;MOVE VALUE TO OUTPUT ; ;GENERATE A RANDOM NUMBER AND STORE IN ;OUTPUT AREA ; GRANM: PUSHJ P,PNTPOS ;POSITION OUTPUT RECORD POINTERS LDB B,PTD ;COUNT FOR LOOP LDB E,PTA ;TYPE GNXTO: PUSHJ P,GNXT ;GET A RANDOM CHAR JRST GGG ;PROCESS IT GNXT: CALLI AC,23 ;GET A RANDOM NUMBER ADD AC,HASH ;ADD RANDOM LSH AC,-5 MOVEM AC,HASH ;STORE A NEW VALUE ANDI AC,177 ;REDUCE TO 7 BITS CAIG E,2 ;TYPE 1 OR 2 JRST GGOOD ;YES CHAR OK CAIN E,4 ;TYPE 4 JRST GGOOD ;YES CHAR OK CAIN E,3 ;TYPE 3 JRST GTYP3 ;YES ANDI AC,37 ;VALID ALPHA? CAIL AC,1 ;LESS 1 CAIL AC,33 ;GT 32 JRST GNXT ;NO GOOD TRO AC,100 TRO AC,40 JRST GGOOD ;CHAR NOW OK GTYP3: ANDI AC,77 ;SET TOP BITS TRO AC,60 CAIL AC,72 ;IN RANGE ? TRZ AC,10 ;NO-THEN MAKE IT SKIPN SIXB SUBI AC,40 GGOOD: POPJ P, GGG: SKIPN SIXB TRZ AC,100 ;CLEAR TOP BIT IDPB AC,C ;STORE BYTE IN OUTPUT SKIPN SIXB ;SKIP ASCII ADDI AC,40 ;CONVERT TTCALL 1,AC SOJN B,GNXTO ;ANY MORE MOVEI AC,15 ;CR TTCALL 1,AC MOVEI AC,12 ;LF TTCALL 1,AC JRST DVAL3 ; ;GET INTERNAL VALUE AND PLACE IN ;OUTPUT AREA ; MVINIT: PUSHJ P,PNTPOS ;POSITION OUTPUT REC POINTERS MOVE D,PTH SKIPE SIXB ;SET UP INIT VAL BYTE POINTERS MOVE D,PTG ; MNXT: LDB B,PTD ;LOOP COUNT MOVE G,BRICK ;INTERNAL AREA POINTERS AOS G ;CORRECT MNXTA: ILDB AC,D ;MOVE FROM INT AREA IDPB AC,C ;TO OUTPUT AREA SKIPN SIXB ;MAKE ASCII IF NESS ADDI AC,40 TTCALL 1,AC ;OUTPUT CHAR SOJN B,MNXTA ;END OF LOOP MOVEI AC,15 ;CR TTCALL 1,AC MOVEI AC,12 ;LF TTCALL 1,AC JRST DVAL3 ; ;POSITION OUTPUT AREA POINTERS ;FOR THIS FIELD OF THE RECORD ; PNTPOS: LDB H,PTC ;START ADDR MOVE C,OPTA ;SIXBIT BYTE POINTER SKIPE SIXB MOVE C,OPTB ;ASCII BYTE POINTER SOSE H ;DEC CHAR 1=POS 0 PNTP: ILDB AC,C ;POSITION SOJG H,PNTP POPJ P, ; ;CALCULATE THE LENGTH IN WORDS OF THE INITIAL ;VALUE ; CLENGT: LDB B,PTD ;LENGTH OF FIELD SKIPE SIXB ;SKIP IF SIXBIT JRST ASC ;ASCII IDIVI B,6 ;NO OF WORDS JUMPE C,CLEX ;REMAINDER ZERO AOJA B,CLEX ;INC BY 1 ASC: IDIVI B,5 ;ASCII JUMPE C,CLEX ;REMAINDER ZERO AOJ B,CLEX ;INC BY 1 CLEX: POPJ P, ;EXIT ; ;CHECK AN ASCII CHARACTER FOR CONVERSION ;TO SIXBIT AND CONVERT IF VALID ; SIXCT: CAIGE AC,40 ;CHECK CHAR VALID SIXBIT JRST SEXTZ ;NO GOOD CAILE AC,137 ;BETWEEN 40 - 13 JRST SEXTZ ;NO GOOD SUBI AC,40 ;CONVERT AOS (P) ;GOOD EXIT SEXTZ: POPJ P, ; ; ;CHECK WHETHER AREA FOR USERS DATA INPUT ;IS EMPTY (INREC IN COBOL) ; GEMPTY: MOVE C,PA ;TAKE COPY OF BYTE POINTER HRRZ B,FSEP SETZ E, ILDB AC,C ;FIRST BYTE CAME AC,B ;FIELD SEP JRST GNXTZA ;NO ILDB AC,PA ;EMPTY STEP ON POINTER MOVEI AC,1 MOVEM AC,@PROMM ;SET PROMM = USER HAS INPUT JRST GOUT2 GNXTZ: ILDB AC,C ;NEXT BYTE HRRZ D,C ;ADDR OF BYTE CAMN D,ENDBUF ;IS IT END OF BUFFER JRST GOUT3 CAMN AC,B ;FIELD SEP JRST GOUT1 ;YES OK GNXTZA: CAIN AC,40 ;IS IT A SPACE JRST GNXTZ ;YES HRRZI E,1 ;SET MARKER NOT ALL SPACES JRST GNXTZ ;GET NEXT CHAR GOUT3: SKIPE E ;ANY NON SPACE GOUT1: AOS (P) ;MORE DATA GOUT2: POPJ P, ;EMPTY ; ;THIS ROUTINE EXTACTS THE NEXT PARAMETER FROM ;THE INPUT BUFFER ,RANGE CHECKS IT ;AND STORES IT IN THE OUTPUT BUFFER ; DRANGE: LDB F,PTD ;LENGTH PUSHJ P,PNTPOS ;SET OUTPUT POINTERS ILDB AC,PA ;FIRST BYTE LDB E,PTA ;INPUT TYPE DRANGA: JRST .(E) ;SWITCH JRST DTYP12 JRST DTYP12 JRST DTYP3 ;TYPE 3 NUMBER JRST DGOOD ;TYPE 4 OK PUSHJ P,ALPHA ;TEST ALPHA TYPE 5 JRST DEXTZ ;INVALID DGOOD: SKIPE SIXB ;IS IT SIXBIT JRST DOK ;NO PUSHJ P,SIXCT ;CHECK VALID SIXBIT JRST DEXTZ ;NO GOOD DOK: IDPB AC,C ;DEPOSIT BYTE DNXT: SOJE F,DFINIT ;END OF FIELD ILDB AC,PA ;NEXT BYTE JRST DRANGA ;NO ; ;HERE THE CORRECT NUMBER OF CHARACTERS ;HAS BEEN EXTRACTED FROM THE USER INPUT BUFFER ; DFINIT: ILDB AC,PA ;NEXT CHAR CAMN AC,B ;IS IT A SEP JRST DEXTZA ;YES CAIE AC,40 ;NO -IS IT A SPACE JRST DEXTZ ;NO -INPUT ERROR DEXTZA: AOS (P) ;EXIT DEXTZ: POPJ P, ; DTYP3: PUSHJ P,NUMR ;TYPE =3 JRST DEXTZ ;INVALID JRST DGOOD ;OK ; DTYP12: PUSHJ P,COMP1 PUSHJ P,CHL ;CONVERT TO BINARY JRST DENDT ;NO GOOD OR END CAIN D,1 ;IS IT NEGATIVE MOVN B,B ;YES CONVERT PUSHJ P,PNTPOS HLL C,OPTC ;SET UP BYTE POINTER IDPB B,C ;DEPOSIT WORD JRST DEXTZA ;FINISHED DENDT: CAMN AC,FSEP ;HAS CONVERT ENDED OK JRST DEXTZA ;YES JRST DEXTZ ;NO ; ;OUTPUT A RECORD FULL OF INFORMATION ; ; GOUTPT: HRRZ B,ORECL ;LENGTH OF RECORD MOVE F,SIXB ;IS IT SIXBIT JUMPE F,GSIXOT ;YES JUMP MOVE AC,OPTB ;ASCII BYTE POINTER JRST GNXTCH GSIXOT: MOVE AC,RECLPT ;RECORD LENGTH ILDB C,AC PUSHJ P,GOUTCH ;OUTPUT IT MOVE AC,OPTC ;36 BIT BYTE POINTER IDIVI B,6 ;CONV LENGTH TO WORDS CAIE C,0 ;IS REMAINDER ZERO AOS B ;NO -INC NO OF WORDS GNXTCH: ILDB C,AC ;GET A BYTE PUSHJ P,GOUTCH ;OUTPUT A CHAR SOJG B,GNXTCH ;GET NEXT ONE JUMPE F,GEND ;IS IT ASCII MOVEI C,15 ;YES OUTPUT CR-LF PUSHJ P,GOUTCH MOVEI C,12 PUSHJ P,GOUTCH GEND: HRRZI AC,3 ;FINISHED SET MARKER MOVEM AC,@PROMM ;FOR COBOL POPJ P, ;EXIT GOUTCH: SOSG OBUF+2 ;ADVANCE BYTE COUNTER PUSHJ P,PUTBUF ;JUMP BUFFER FULL IDPB C,OBUF+1 ;PUT BYTE IN BUFFER POPJ P, ;GET NEXT BYTE PUTBUF: OUT 3, ;GIVE BUFFER TO MONITOR POPJ P, ;GOOD RETURN JRST E3 ;ERROR RETURN ; ;ADD INCREMENT TO INITIAL VALUE AND ;CHECK THE RANGE ; AINCR: LDB E,PTA ;TYPE LDB B,PTD ;LENGTH LDB C,PTF ;INCREMENT MOVE G,BRICK ;POINT TO INIT VALUE AOS G MOVE F,PTG ;BYTE POINTER ASCII SKIPN SIXB ;IS IT SIXBIT MOVE F,PTH ;YES MOVE H,SMARK ;RESET BYTE POINTER MARK SKIPE SIXB ;IS IT SIXBIT MOVE H,AMARK ;NO ARS: ILDB AC,F ;RESET BYTE POINTER SOJG B,ARS ;TO LAST BYTE LDB B,PTD ;RESET LENGTH JRST .(E) ;SWITCH ON TYPE JRST AT12 ;TYPE 1 JRST AT12 ;TYPE 2 JRST AT3 ;TYPE 3 JRST AT4 ;TYPE 4 JRST AT5 ;TYPE 5 AT3: JUMPE C,AT3A ;IS IN ZERO LDB AC,F ;GET CURRENT CHAR SKIPE SIXB ;IF ASCII MAKE SIXBIT SUBI AC,40 ; IDIVI C,12 ;DIVIDE INC BY 10 ADD AC,D ;ADD REMAINDER CAIG AC,31 ;>9 IN THIS POSITION JRST AT3B ;NO CHAR OK AOS C ;ADD CARRY TO REST SUBI AC,12 ;PUT NEW CHAR IN RANGE AT3B: SKIPE SIXB ;IS IT SIXBIT ADDI AC,40 ;NO- MAKE ASCII DPB AC,F ; SOJE B,AT3A ;FINISH IF LAST PUSHJ P,UPBP ;UPDATE BYTE POINTERS JRST AT3 ;NEXT BYTE AT3A: POPJ P, ;FINISHED AT4: SKIPE SIXB ;IS IT SIXBIT JRST AT4C ;NO AT4D: JUMPE C,AT4A ;IS INC ZERO LDB AC,F ;GET CURRENT CHAR IDIVI C,100 ;DIVIDE BY 100 OCT ADD AC,D ;ADD REMAINDER CAIG AC,77 ;> 77 OCT JRST AT4B ;NO CHAR OK AOS C ;ADD CARRY TO REST SUBI AC,100 ;PUT CHAR IN RANGE AT4B: DPB AC,F ;STORE BACK CHAR SOJE B,AT4A ;FINISH IF LAST PUSHJ P,UPBP ;UPDATE BYTE POINTERS JRST AT4D ;NEXT BYTE AT4A: POPJ P, ;FINISHED AT4C: JUMPE C,AT4A ;IS INC ZERO LDB AC,F ;GET CURRENT CHAR IDIVI C,200 ;DIVIDE INC BY 200 ADD AC,D ;ADD REMAINDER CAIG AC,177 ;> 177 OCT JRST AT4E ;NO - CHAR OK AOS C ;ADD CARRY TO REST SUBI AC,200 ;PUT CARRY IN RANGE AT4E: DPB AC,F ;STORE BACK CHAR SOJE B,AT4A ;FINISH IF LAST PUSHJ P,UPBP ;UPDATE BYTE POINTER JRST AT4C ;NEXT BYTE AT5: JUMPE C,AT5A ;IS INC ZERO LDB AC,F ;GET CURRENT CHAR SKIPE SIXB ;IF ASCII MAKE SIXBIT SUBI AC,40 IDIVI C,32 ;DIVIDE INC BY 32 OCT ADD AC,D ;ADD REMAINDER CAIG AC,73 ;> Z IN THIS POS JRST AT5B ;NO CHAR OK AOS C ;ADD CARRY TO REST SUBI AC,32 ;PUT NEW CHAR IN RANGE CAIE AC,73 ; SETZ AC, ;MAKE CHAR A SPACE AT5B: CAIGE AC,41 ;IF IT WAS A SPACE MAKE A HRRZI AC,41 ; SKIPE SIXB ;RESET TO ASCII IF REQUIRED ADDI AC,40 ; DPB AC,F ;STORE BACK SOJE B,AT3A ;FINISH IF LAST PUSHJ P,UPBP ;UPDATE BYTE POINTERS JRST AT5 ;NEXT BYTE AT5A: POPJ P, ;FINISHED ; ;NOT YET WRITTEN AT12: MOVE F,PTN ;BYTE POINTER ILDB AC,F ;LOAD INIT VALUE ADD AC,C ;ADD INCREMENT DPB AC,F ;STORE RESULT POPJ P, ;EXIT UPBP: MOVEI AC,60000 ;SIXBIT MARKER SKIPE SIXB MOVEI AC,70000 ;ASCII MARKER HRLZ AC,AC ADD F,AC ;UPDATE BYTE POINTER CAMG F,TOP ;TO LARGE POPJ P, ;EXIT SOS G ;DECREASE ADDR DPB H,AMARKR ;RESET POINTER POPJ P, ;EXIT ;************************************************** ;*************************************************** ; ; ;CLOSE DOWN IO AND EMPTY BUFFERS ; CLOS: CLOSE 3,0 RELEASE 3, POPJ P, ;************************************************** ;************************************************** ; ;WRITE INTERNAL 2000 DEC WORD RECORD AREA ;TO DSK ; RECRIT: PUSHJ P,FILMOV ;TRANSFER FILNAME MOVE AC,@2(16) ;ADDR OF AREA SOS AC HRRM AC,IOLST ;SET UP START ADDR OPEN 0,OPNBLK ;OPEN CHANNEL JRST E1 ;ERROR RETURN ENTER 0,EEE ;SELECT FILE JRST E2 OUTPUT 0,IOLST ;OUTPUT 1 BLOCK JRST RECLOS JRST E3 ;ERROR RETURN RECLOS: CLOSE 0,0 RELEASE 0, POPJ P, OPNBLK: 17 SIXBIT/DSK/ 0 IOLST: IOWD ^D2000,@BRICK 0 ;************************************************* ;************************************************* ; ;READ IN RECORD LAYOUT AREA ; ; RECRED: PUSHJ P,FILMOV MOVE AC,@2(16) ;ADDR FOR INPUT SOS AC HRRM AC,IOLST ;SET UP START ADDR OPEN 0,OPNBLK JRST E1 ;ERROR LOOKUP 0,EEE JRST E2 ;ERROR INPUT 0,IOLST ;INPUT THE RECORD JRST RECLOS JRST E3 PTI: POINT 6,@BRICK,11 ;REC ID PTJ: POINT 6,@BRICK,35 ;FILLER PTK: POINT 18,@BRICK,29 ;LENGTH RECID: 0 OUTPT: BLOCK 1000 ;OUTPUT REC AREA OPTC: POINT 36,OUTPT ; OPTA: POINT 6,OUTPT ; OPTB: POINT 7,OUTPT ; ENDBUF: 0 DPROMT: 0 FSEP: 0 USINPT: 0 ;USER INPUT POINTER ORECL: 0 ;OUTPUT RECORD LENGTH PROMM: 0 ;MARKER 1= PROMPT SENT RECLPT: POINT 36,ORECL ;RECORD LENGTH BYTE POINTER TOP: 360000000000 SMARK: 600 AMARK: 10700 AMARKR: POINT 12,(F),11 HASH: 0 END