Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
iogen.mac
There are 22 other files named iogen.mac in the archive. Click here to see a list.
; UPD ID= 2023 on 8/24/79 at 1:53 PM by <NIXON>
TITLE IOGEN FOR COBOL V12
SUBTTL I/O GENERATORS AL BLACKINGTON/SIP/CAM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
;EDITS
;V12*****************
;NAME DATE COMMENTS
;DMN 1-DEC-78 [605] MAKE VARIABLE LENGTH READS WORK USEFULLY
;V10*****************
;NAME DATE COMMENTS
;VR 20-SEP-77 ;[512] CHECK FOR COMP ITEM AT 01 LEVEL WHEN DOING A BINARY WRITE
;EHM 20-MAY-77 [474] PUT OUT ERROR MESSAGE WHEN TRYING TO DO A
; READ INTO ON A RECORD OF ZERO SIZE.
;MDL 04-NOV-76 [447] GIVE WARNING WHEN ATTEMPTING TO 'ACCEPT' MORE THAN
; 1023 CHARACTERS INTO AN AREA.
;DPL 23-JUN-76 [430] FIX ACCGEN WHEN ARG HAS FAULTY SUBSCRIPT
; 18-FEB-76 [407] FIX STD ASCII WRITING BEFORE/AFTER
;ACK 26-APR-75 DISPLAY DISPLAY-9 ITEMS.
;********************
; EDIT 366 FIX DISPLAY OF DISPLAY-7 ITEMS SO NO EXTRA <CR-LF> DONE.
; EDIT 357 FIX RECOVERY IF RECORD NAME IS NOT DEFINED IN READ INTO STATEMENTS.
; EDIT 345 FIX SUBSCRIPTED DISPLAY ITEM SO NO ADVANCING WORKS.
; EDIT 252 FIXES POSSIBLE PUSHDOWN LIST PROBLEM OF EDIT 122
; EDIT 245 FIXES READ INTO AT END GENERATE TO MAKE INTO WORK
; EDIT 176 FIXES ACCEPT FOO FOR FOO A DISPLAY ITEM IN LINKAGE SECTION.
; EDITS 166,163 131 ALLOW ADVANCING ITEM TO BE SUBSCRIPTED.
TWOSEG
RELOC 400000
SALL
;MACRO DEFINITIONS:
;SET CURRENT AC'S TO THE VALUE X
DEFINE SETAC (X), <
IFE X,<SETZM EAC>
IFN X,<
MOVEI TE,X
MOVEM TE,EAC>
>
;EXECUTE Z IF A MODE IS EQUAL TO Y
DEFINE MODTRU (W,X,Y,Z),<
HRRZ T'W,EMODE'X
CAIN T'W,Y'MODE
IFG Z-777777,<Z>
IFLE Z-777777,<
JRST Z>
>
;EXECUTE Z IF A MODE IS NOT EQUAL TO Y
DEFINE MODFLS (W,X,Y,Z),<
HRRZ T'W,EMODE'X
CAIE T'W,Y'MODE
IFG Z-7777777,<X>
IFLE Z-777777,<
JRST Z>
>
;SPECIAL CASES OF MODTRU & MODFLS
DEFINE TMODEA (Y,Z),<
MODTRU E,A,Y,Z
>
DEFINE FMODEA (Y,Z),<
MODFLS E,A,Y,Z
>
DEFINE TMODEB (Y,Z),<
MODTRU E,B,Y,Z
>
DEFINE FMODEB (Y,Z),<
MODFLS E,B,Y,Z
>
;EXECUTE (OR GO TO) Z IF INTEGRAL PLACES OF A > B
DEFINE INTAGB (Z),<
MOVE TE,ESIZEA
SUB TE,EDPLA
SUB TE,ESIZEB
ADD TE,EDPLB
IFLE Z-777777,<JUMPG TE,Z>
IFG Z-777777,<SKIPLE TE
Z
>
>
;EXECUTE (OR GO TO) Z IF DECIMAL PLACES OF A > B.
DEFINE DPAGB (Z),<
MOVE TE,EDPLA
CAMLE TE,EDPLB
IFG Z-777777,<Z>
IFLE Z-777777,<JRST Z>
>
;EXECUTE (OR GO TO) Z IF DECIMAL PLACES OF B > A.
DEFINE DPBGA (Z),<
MOVE TE,EDPLB
CAMLE TE,EDPLA
IFG Z-777777,<Z>
IFLE Z-777777,<JRST Z>
>
;EXECUTE (OR GO TO) Z IF DECIMAL PLACES OF A = B.
DEFINE DPAEB (Z),<
MOVE TE,EDPLA
CAMN TE,EDPLB
IFG Z-777777,<Z>
IFLE Z-777777,<JRST Z>
>
;EXIT IF THE ERROR FLAG IS ON
DEFINE EQUIT,<
TSWF FERROR
POPJ PP,
>
IOGEN::
EXTERNAL MOVGEN
EXTERNAL PUTASY, PUTASN
EXTERNAL MOVGN., MXX., MXTMP., MACX., MXAC.
EXTERNAL SETOPN, GETEMP,SUBSCR,PUT.LD,LITD.
EXTERNAL STASHP,STASHQ,POOLIT,PLITPC
EXTERNAL FATAL, OPFAT, OPNFAT, BADEOP, LNKSET,WARN
EXTERNAL KILL, BMPEOP, EWARN
EXTERNAL ASRJ.,AQRJ.,AZRJ.,SPIFGN,READEM
EXTERNAL FPMODE,F2MODE
EXTERNAL ESIZEZ,ADDI.,TLO.,TLZ.
ENTRY READGN ;"READ" GENERATOR
ENTRY RITEGN ;"WRITE" GENERATOR
ENTRY OPENGN ;"OPEN" GENERATOR
ENTRY CLOSGN ;"CLOSE" GENERATOR
IFN ANS68,<
ENTRY SEEKGN ;"SEEK" GENERATOR
>
IFN ANS74,<
ENTRY STRTGN ;"START" GENERATOR
>
ENTRY DISPGN ;"DISPLAY" GENERATOR
ENTRY ACCGEN ;"ACCEPT" GENERATOR
ENTRY REWGEN ;"REWRITE" GENERATOR
ENTRY DELGEN ;"DELETE" GENERATOR
INTERNAL LARGE,LARGER ;FIND LARGEST RECORD FOR A FILE [245]
;GENERATE AN "OPEN"
OPENGN: PUSHJ PP,SETOP ;SET UP EOPTAB
EQUIT;
IFN ANS74,<
LDB CH,FI.LCI## ;NEED TO CONVERT LINAGE-COUNTER
JUMPE CH,OPENG2 ;NO
PUSHJ PP,RIFTAG## ;REFERENCE IF TAG
HRLI CH,EPJPP ;"PUSHJ PP,"
PUSHJ PP,PUTASY ;GENERATE CALL TO INLINE ROUTINE
OPENG2:>
MOVSI CH,OPN##
LDB TE,[POINT 2,W1,14]
DPB TE,[POINT 2,CH,14] ;PASS ON OPEN EXTENDED AND REVERSED
OPNGN1: LDB TE,[POINT 3,W1,11]
DPB TE,[POINT 3,CH,11]
IFN ANS68,<
JRST PUTOP
>
IFN ANS74,<
PUSHJ PP,CNVKYB ;SEE IF KEY NEEDS CONVERTING
PUSHJ PP,PUTOP
JRST CNVKYC ;SEE IF KEY NEEDS CONVERTING BACK
>
;GENERATE A "CLOSE"
CLOSGN: PUSHJ PP,SETOP
EQUIT;
MOVSI CH,CLOS##
IFN ANS74,<
TLNE W1,(1B13) ;IF 'FOR REMOVAL' BIT ON
TLO CH,(1B13) ;PASS IT ON
>
TLNN W1,DELETF ;IF 'DELETE' FLAG NOT UP,
JRST OPNGN1 ; THIS IS A STANDARD CLOSE
MOVSI CH,PURGE. ;THIS IS A 'CLOSE WITH DELETE'
IFN ANS68,<
JRST PUTOP
>
IFN ANS74,<
PUSHJ PP,CNVKYB ;SEE IF KEY NEEDS CONVERTING
PUSHJ PP,PUTOP
JRST CNVKYC ;SEE IF KEY NEEDS CONVERTING BACK
>
;GENERATE CODING FOR "READ"
READGN: MOVEI CH,READ##
IFN ANS74,<
TLNE W1,(1B10) ;READ NEXT?
MOVEI CH,RDNXT.## ;YES
>
MOVEM CH,EIOOP
PUSHJ PP,SETOP ;SET UP OPERAND
EQUIT;
PUSHJ PP,VLTST ;[605] TEST FOR VARIABLE LENGTH
RDGN0: SETZM EINTO ;CLEAR "INTO" INDICATION
TLNN W1,INTO ;"INTO" OPTION FOR THIS READ?
JRST RDGN1 ;NO
PUSHJ PP,LARGE ;YES--FIND LARGEST DATA RECORD FOR THIS FILE
MOVE TA,OPERND
HRRZ TE,EOPNXT
SUBI TE,2(TA)
JUMPL TE,RDGN9
HRRZI TC,EINTO+2
HRLI TC,2(TA)
BLT TC,EINTO+2(TE)
RDGN1:
IFN ANS68,<
MOVS CH,EIOOP
PUSHJ PP,PUTOP ;SET UP AND WRITE OPERATOR
>
IFN ANS74,<
;17-AUG-79 /DAW DON'T ALLOW DELETE FOR SEQ. FILE
HRRZ CH,EIOOP
CAIE CH,DELETE##
JRST RDGN1A ;NOT DELETE, OK
MOVE TA,CURFIL ;FIND ACCESS MODE FOR FILE
LDB TD,FI.ACC
JUMPN TD,RDGN1A ;DELETE IS OK
MOVEI DW,E.729 ;"DELETE NOT ALLOWED FOR SEQ FILES"
PUSHJ PP,OPFAT
RDGN1A: MOVS CH,EIOOP
PUSHJ PP,CNVKYB ;SEE IF KEY NEEDS CONVERTING
PUSHJ PP,PUTOP
PUSHJ PP,CNVKYA ;SEE IF KEY NEEDS CONVERTING BACK
>
;"READ" (CONT'D)
;CHECK TO SEE THAT THE NEXT OPERATOR IS "SPIF"
PUSHJ PP,RDGN10 ;READ UP THRU NEXT OPERATOR
CAIN TE,SPIF.
TLNN W1,ATINVK
JRST RDGN5
IFN ANS68,<
LDB TE,FI.ACC ;IS FILE
JUMPN TE,RDGN3 ; SEQUENTIAL?
>
IFN ANS74,<
LDB TE,FI.FAM## ;GET ACCESS MODE
JRST @[EXP RDGN2,RDGN2,RDGN3D,RDGN3D](TE)
RDGN3D: MOVE TE,EIOOP ;GET LAST OPERATOR
CAIE TE,RDNXT. ;READ NEXT IS SEQUENTIAL
JRST RDGN3 ;RANDOM
;SEQUENTIAL
>
RDGN2: TLNE W1,ATEND ;YES--IS SPIF "AT END"?
JRST SPIFGN ;YES--DO IT
MOVEI DW,E.208 ;NO--TROUBLE
JRST RDGN4
RDGN3: TLNE W1,INVKEY ;IT'S RANDOM FILE--IS SPIF "INVALID KEY"?
JRST SPIFGN ;YES--DO IT
MOVEI DW,E.209 ;NO--TROUBLE
RDGN4: LDB CP,W1CP
LDB LN,W1LN
PUSHJ PP,WARN
JRST SPIFGN
RDGN5:
IFN ANS74,<
CAIE TE,NOOP.## ;DUMMY TO MAKE READ HAPPY?
JRST RDGN6 ;NO
MOVE TE,EIOOP ;
CAIE TE,DELETE ;IF DELETE <FILE-NAME>
JRST RDGN5A ;NOT
LDB TE,FI.FAM ;GET ACCESS
CAIG TE,%FAM.S ;IF SEQUENTIAL
JRST NOOPGN ;GENERATE A NOOP SINCE INVALID KEY NOT ALLOWED
RDGN5A: LDB TA,FI.ERR## ;SEE IF THERE IS A FILE SPECIFIC ERROR PROCEDURE
JUMPE TA,[SKIPN TA,USP.I## ;NO, SEE IF GENERAL USE PROCEDURE
SKIPE TA,USP.IO## ;OR FOR I-O
JRST RDGN5B ;OK, USE IT
JRST RDGN6] ;NO, GIVE ERROR RETURN
LDB TB,[POINT 3,TA,20]
CAIE TB,CD.PRO
JRST RDGN6 ;NOT A PROTAB LINK
PUSHJ PP,LNKSET ;GET PROTAB
LDB TA,PR.SFI## ;GET TAG
RDGN5B: MOVE CH,[JRST.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZI CH,AS.DOT+2
PUSHJ PP,PUTASN ;OK RETURN
MOVE CH,TA ;GET TAG
RDGN5C: HRLI CH,EPJPP ;PUSHJ 17,
PUSHJ PP,PUTASY## ;EOF RETURN
JRST ENDIFR## ;SEE IF READ INTO
>
;READ WAS NOT FOLLOWED BY A "SPIF" OF CORRECT TYPE
RDGN6:
IFN ANS74,<
;CHECK FOR USE ERROR PROCEDURE AND IF GIVEN USE IT
LDB TE,FI.ENT## ;IS USE PROCEDURE FOR OPEN
JUMPN TE,RDGN6A ;YES, GIVE ERROR
LDB TE,FI.ERR## ;ERROR USE GIVEN
JUMPE TE,RDGN6A ;NO
MOVE CH,[JRST.+ASINC,,AS.MSC##] ;JRST.
PUSHJ PP,PUTASY
MOVEI CH,AS.DOT##+2 ;.+2
PUSHJ PP,PUTASN
PUSH PP,TA ;SAVE PTR
LDB TA,FI.ERR ;GET PRO-TAG
PUSHJ PP,LNKSET ;GET ADDRESS
LDB CH,PR.SFI## ;GET TAG
POP PP,TA
ANDI CH,77777 ;ONLY
IORI CH,AS.TAG## ;SET BIT
JRST RDGN5C
RDGN6A:>
MOVEI DW,E.318 ;ASSUME FILE IS SEQUENTIAL
LDB TE,FI.ACC ;IF FILE IS NOT
SKIPE TE ; SEQUENTIAL
MOVEI DW,E.319 ; USE 'INVALID KEY REQUIRED'
RDGN7: MOVE TC,OPLINE
LDB CP,TCCP
LDB LN,TCLN
PUSHJ PP,FATAL
IFN ANS74,<
CAIN W2,NOOP. ;IF NOOP.,
POPJ PP, ; SKIP IT
>;END IFN ANS74
JRST @EOPCOD(W2)
;NOT ENOUGH OPERANDS FOR "READ INTO"
RDGN9: SETZM EINTO
JRST BADEOP
;READ UP THRU NEXT OPERATOR
RDGN10: MOVE EACA,EOPLOC ;RESET
MOVEM EACA,EOPNXT ; EOPTAB
SETZB EACC,ETEMPC ;MORE RESETS
PUSHJ PP,READEM ;DO THE READ
HRRZ TE,W2 ;PICK UP OPERATOR CODE
MOVE TA,CURFIL ;SET 'TA' TO CURRENT FILE
POPJ PP,
;GENERATE CODING FOR "WRITE"
RITEGN: MOVEI CH,WRITE## ;SET UP 'WRITE' UUO
RITGN0: MOVEM CH,EIOOP
PUSHJ PP,SETOP ;SET UP OPERAND
EQUIT;
RITG00: MOVE TE,CURFIL ;OPERAND IS ACTUALLY
MOVEM TE,CURDAT ; A RECORD-NAME
PUSHJ PP,GTFATH ;SET UP "FT"
EQUIT
MOVE TA,CURDAT
LDB TE,DA.EXS ;GET RECORD SIZE
REPEAT 0,<
;EDIT 512 WAS ADDED TO WRITE OUT ONLY 1 WORD FOR A 1-WORD COMP RECORD.
; IF THE KEY WAS S9(10), COBOL TREATED THIS AS 10 CHARACTERS, WHICH
; TRANSLATED TO 2 WORDS IN CBLIO.
;
; THIS IS REMOVED IN VERSION 12 FIELD TEST BECAUSE SOMEONE FOUND THAT
;THIS MAKES IT INCOMPATIBLE WITH READ. FIXING "READ" IS NOT A GOOD IDEA
;BECAUSE THAT MAKES IT INCOMPATIBLE WITH FILES WRITTEN BEFORE VERSION 12.
;THEREFORE, THE OLD CODE HAS BEEN RESTORED.
LDB TB,DA.USG ;[512] GET USAGE
SKIPE EBCMP3## ;[512] DO WE HAVE /X
JRST RITG10 ;[512] YES- CHECK FOR COMP
CAIN TB,SIXLIT## ;[512] IS IT 1-WORD COMP?
MOVEI TE,6 ;[512] YES-USE SIZE OF SIX CHARS
CAIN TB,FPMODE ;[512] IS IT 2-WORD COMP?
MOVEI TE,12 ;[512] YES - USE SIZE OF 12 CHARS
RITG1B:
>;END REPEAT 0 FOR EDIT 512
MOVEM TE,ERECSZ ;SAVE IT
SETZM WDPITM ;ASSUME NO DEPENDING ITEM
HLRZ TE,CURDAT ;CHECK FOR DEPENDING VARIABLES
HRRZM TE,ETABLA## ; SO WE CAN DO A VARIABLE LENGTH WRITE
PUSHJ PP,DEPTSA## ;SKIP IF WE HAVE ONE
JRST RITG1C ;NO
HRRZ TE,ETABLA ; YES--SAVE LINK
HRRZM TE,WDPITM ;SAVE 0,,LINK
RITG1C: TLNN W1,FROM
JRST RITGN1
MOVE TC,OPERND ;GET RECORD TABLE-LINK
MOVEI TA,2(TC) ;GET "FROM" DATA-NAME
MOVEM TA,CUREOP
PUSHJ PP,MOVGN. ;GENERATE MOVE
RITGN1: MOVE TA,CURFIL
LDB TD,FI.ACC
MOVE TE,EIOOP ;GET VERB BACK
IFN ANS68,<
CAIE TD,2 ;IF FILE IS INDEXED
CAIN TE,WRITE ; OR THIS IS A 'WRITE'
JRST RITG1A ; ALL IS WELL
MOVEI DW,E.371 ;'NOT LEGAL UNLESS ISAM'
PUSHJ PP,OPFAT
>
RITG1A: JUMPE TD,RITG1E ;IF SEQUENTIAL, WE CAN HAVE ADVANCING
TLNN W1,ADVANC ;IS THERE AN ADVANCING CLAUSE?
JRST RITGN2 ;NO ADVANCING
MOVEI DW,E.372 ;'ADVANCING ILLEGAL'
PUSHJ PP,OPFAT
JRST RITGN3
RITG1E: TLNE W1,ADVANC!POSTNG ;"ADVANCING" OR "POSITIONING" OPTION.
JRST WADVGN ;YES
IFN ANS74,<
CAIE TE,WRITE ;IF ITS DELETE OR REWRITE
JRST RITGN2 ;DON'T SET WADV. BY MISTAKE
>
LDB TB,FI.ERM ;GET EXTERNAL RECORDING MODE
CAIE TB,%RM.SA ; [407] IF NOT STD ASCII
CAIN TB,%RM.7B ; [407] OR ASCII
CAIN TE,2 ; OR ACCESS MODE IS INDEXED,
JRST RITGN2 ; USE NORMAL WRITE
HRRZI TC,1 ;USE "ADVANCING".
IFN ANS74,<
TLO W1,AFTER ;"AFTER"
>
JRST WADVG5
;"WRITE" GENERATOR (CONT'D).
; NO ADVANCING
RITGN2:
IFN ANS68,<
MOVE TE,EIOOP ;IF THIS IS
CAIN TE,DELETE## ; A 'DELETE',
JRST RITG2B ; SKIP SOME CODE
LDB TE,FI.ACC ;IS IT
CAIE TE,2 ; INDEXED FILE?
JRST RITG2B ;NO
;GENERATE MOVE OF SYMBOLIC KEY TO RECORD KEY
MOVE EACA,EOPLOC
MOVEM W1,1(EACA)
MOVEM W1,3(EACA)
PUSH PP,TA ;SAVE TA
LDB TA,FI.SKY ;GET POINTER TO SYBOLIC KEY
;DEL [252] JUMPE TA,RITG2B ;IF SYMBOLIC POINTER IS 0, QUIT
JUMPN TA,RITG2A ; SEE IF OKAY [252]
POP PP,TA ; NO [252]
JRST RITG2B ; DON'T MOVE [252]
RITG2A: PUSHJ PP,LNKSET ; [252]
LDB TB,DA.LKS## ; SYMBOLIC KEY IN LINKAGE SECTION?
POP PP,TA ;RESTORE TA
LDB TE,FI.SKY ;PICK UP POINTER TO SYMBOLIC KEY
JUMPE TB,.+3 ;IN LINKAGE SECTION?
MOVSI TB,(LKSFLG) ;YES, SET THE LINKAGE SECT. FLAG
IORM TB,1(EACA) ;IN FIRST WORD OF EOPTAB ENTRY
MOVEM TE,2(EACA)
LDB TE,FI.RKY
JUMPE TE,RITG2B
MOVEM TE,4(EACA)
ADD EACA,[XWD 4,4]
MOVEM EACA,EOPNXT
PUSHJ PP,MOVGEN
>
;PUT OUT 'WRITE', 'REWRITE', OR 'DELETE'
RITG2B: HRLZ CH,EIOOP ;GET OP-CODE
IFN ANS74,<
PUSHJ PP,CNVKYB ;SEE IF KEY NEEDS CONVERTING
>
SKIPN TE,WDPITM## ;DEPENDING VARIABLE OPTION?
JRST RITG2C ;NO, SKIP CODE
TRNN TE,-1 ;ARE WE SURE?
JRST RITG2C ;NO
TLNE TE,-1 ; HAVE TO PRESERVE %PARAM+0?
SETOM SAVPR0## ;YES, TELL SZDPVA
HRRZM TE,ETABLA ;LOOK FOR LINK IN ETABLA
MOVEI TE,15 ; LOAD SIZE IN RUNTIME AC 15
PUSHJ PP,SZDPVA##
JRST DPPER1 ;?ERRORS
;PUT OUT "MOVEI AC16,LIT"
; PUSHJ PP,WRITV.##
HLRZ CH,CURFIL
ANDI CH,LMASKB
IORI CH,AS.FIL
HRLI CH,MOVEI.##+AC16
PUSHJ PP,PUTASY
MOVEI CH,WRITV.##
PUSHJ PP,PUT.PJ
JRST PUTXDD ;GO PUT OUT XWD FOLLOWING
; THIS SHOULD NEVER HAPPEN
DPPEMS: ASCIZ/% IOGEN -- PROBLEM WITH DEPENDING VARIABLE, IGNORED
/
DPPER1: TTCALL 3,DPPEMS ;% PROBLEM WITH DEPENDING VARIABLE--IGNORED
; JRST RITG2C
RITG2C: PUSHJ PP,PUTOP ;SET UP AND WRITE OPERATOR
PUTXDD: SETZM WDPITM## ;CLEAR DEPENDING ITEM FLAG
MOVE CH,[XWD AS.XWD,1] ;PUT OUT XWD
PUSHJ PP,PUTASY
MOVE CH,ERECSZ ;PUT RECORD SIZE IN
ROT CH,-14 ; BITS 0-11
HRRI CH,AS.CNB
PUSHJ PP,PUTASN
HRRZI CH,0 ;ZERO FOR RIGHT HALF
PUSHJ PP,PUTASN
IFN ANS74,<
PUSHJ PP,CNVKYA ;SEE IF KEY NEEDS CONVERTING BACK
>
;IF FILE IS RANDOM OR ISAM--"INVALID KEY" REQUIRED
RITGN3: SETZM WDPITM## ;CLEAR DEPENDING ITEM
PUSHJ PP,RDGN10 ;READ UP THRU NEXT OPERATOR
CAIE TE,SPIF.
JRST RITGN5
RITGN4: SETZM EINTO ;CLEAR READ INTO FLAG FOR ENDIFGEN
LDB TE,FI.ACC
TLNN W1,INVKEY
JRST RITGN7
;"INVALID KEY" FOUND
JUMPN TE,SPIFGN ;IF NOT SEQ, ALL OK
RITGN6: MOVEI DW,E.320 ;"INV KEY NOT ALLOWED"
JRST RDGN7
;"AT END" FOUND
RITGN7:
IFN ANS68,<
JUMPE TE,RITGN6 ;IF FILE IS SEQ,
>
IFN ANS74,<
JUMPN TE,RITGN8 ;FILE NOT SEQ.
TLNE W1,ATEOP## ;END OF PAGE?
JRST SPIFGN ;YES
>
RITGN8: MOVEI DW,E.319 ;"INV KEY REQUIRED"
JRST RDGN7
;NO "SPIF" OF ANY KIND FOUND
;[74] CHECK FOR ERROR USE PROCEDURE ANS IF GIVEN USE IT
RITGN5:
IFN ANS74,<
LDB TE,FI.ACC ;GET ORGANIZATION MODE
JUMPE TE,RITGN9 ;SEQUENTIAL
LDB TA,FI.ERR## ;SEE IF FILE SPECIFIC ERROR PROCEDURE
JUMPE TA,[SKIPN TA,USP.O## ;NO, SEE IF GENERAL USE PROCEDURE
SKIPE TA,USP.IO## ;OR FOR I-O
JRST RTGN8A ;OK, USE IT
JRST RITGN7] ;NO, GIVE ERROR
LDB TB,[POINT 3,TA,20]
CAIE TB,CD.PRO
JRST RITGN7 ;NOT A PROTAB?
PUSHJ PP,LNKSET ;GET ADDRESS
LDB TA,PR.SFI## ;GET TAG
RTGN8A: MOVE CH,[JRST.+ASINC,,AS.MSC##] ;JRST.
PUSHJ PP,PUTASY
MOVEI CH,AS.DOT##+2 ;.+2
PUSHJ PP,PUTASN
MOVE CH,TA ;GET TAG
HRLI CH,EPJPP ;PUSHJ 17,
PUSHJ PP,PUTASY
JRST @EOPCOD(W2) ;DO NEXT OPERATOR
>
RITGN9: LDB TE,FI.ACC ;IF FILE IS NOT SEQ,
JUMPN TE,RITGN8 ; TROUBLE
JRST @EOPCOD(W2)
REPEAT 0,<
;(EDIT 512 HAS BEEN REMOVED)
;BINARY WRITE - WITH /X
RITG10: CAIN TB,SIXLIT ;[512] IS IT 1-WORD COMP?
MOVEI TE,4 ;[512] YES - USE SIZE OF 4 CHARS
CAIN TB,FPMODE ;[512] IS IT 2-WORD COMP?
MOVEI TE,8 ;[512] YES - USE SIZE OF 8 CHARS
JRST RITG1B ;[512] CONTINUE
>;END REPEAT 0
;GENERATE CODE FOR "WRITE" (WITH ADVANCING)
;**; DELETED WADVGN: MOVE EACC,EOPNXT
WADVGN: HRRZ EACC,EOPLOC ; LOCATION OF 2ND OPERATOR WORD [163]
HLRZ TA,2(EACC) ; PICK UP NO. OF SUBSCRIPTS OF RECORD [ 163]
IMULI TA,2 ; SKIP TO NEXT ITEM-2ND WORD [163]
ADDI EACC,4(TA) ; [163]
TLNN W1,FROM ; SEE IF ANY FROM OPERAND [166]
JRST WADVGA ; NO WE ARE AT ADVANCING ITEM [166]
HLRZ TA,(EACC) ; SEE IF FROM OPERAND SUBSCRIPTED [166]
IMULI TA,2 ; SKIP AROUND ANY FROM SUBSCRIPTS [166]
ADDI EACC,2(TA) ; NOW WE ARE AT ADVANCING ITEM-2N WRD [166]
WADVGA: ; NEW LABEL NEEDED [166]
HRRZM EACC,CUREOP ; SAVE ADVANCING ITEM [163]
SOS CUREOP ; POINT BACK TO 1ST WORD OF ADV ITEM [163]
SKIPN TA,0(EACC) ;GET TABLE-LINK FOR "ADVANCING" OPERAND
JRST [MOVE TC,-1(EACC) ;MIGHT BE "ZERO"
TLNN TC,GNFIGC+GNFCZ ;IS IT?
JRST BADLIN ;NO, GIVE ERROR
SETZ TC, ;YES
JRST WADG2B] ;AND CONTINUE
IFN ANS74,<
CAIN TA,PAGE. ;'ADVANCING PAGE'
JRST WADG2P ;YES, PUT OUT CHANNEL 1
>
PUSHJ PP,LNKSET
MOVE TC,-1(EACC)
TLNN TC,GNLIT ;IS IT A LITERAL?
JRST WADVG4 ;NO
TLNN TC,GNNUM ;YES--IS IT NUMERIC?
JRST BADLIN ;NO--ERROR
HRLI TA,350700 ;YES--CREATE A BYTE POINTER TO LITERAL IN VALTAB
LDB TD,TA ;GET SIZE
JUMPE TD,BADLIN ;IF ZERO--ERROR
MOVEI TC,0 ;SET RESULT TO ZERO
WADVG2: ILDB TE,TA ;GET A DIGIT
CAIG TE,"9" ;IS IT REALLY A DIGIT?
CAIGE TE,"0"
JRST BADLIN ;NO--ERROR
ADDI TC,-"0"(TE) ;YES--ADD INTO RESULT
CAILE TC,^D66 ;TOO BIG?
JRST BADLIN ;YES--ERROR
SOJLE TD,WADG2B ;NO--ANY MORE DIGITS?
IMULI TC,^D10 ;YES
JRST WADVG2
WADG2B: TLNN W1, POSTNG ;POSITIONING?
JRST WADVG3 ;NO, GO DO ADVANCING.
JUMPN TC, WADG2D ;DOES HE WANT A FORM FEED?
WADG2P: ;[ANS74] ADVANCING PAGE
MOVE TC, [XWD 1,1] ;YES, PUT OUT CHANNEL 1.
JRST WADVG5
WADG2D: CAILE TC, 3 ;ONLY ALLOW UP TO TRIPLE SPACING
JRST BADPNU ; FOR POSITIONING.
WADVG3: HRRZI TC,(TC) ;SET CHANNEL TO 8 MOD 8.
JRST WADVG5
WADVG4: LDB TE,[POINT 3,0(EACC),20] ;GET TYPE OF OPERAND
CAIE TE,TB.MNE
JRST WADVG6
MOVE TC,1(TA)
TLNN TC,MTCHAN
JRST BADMNE
LDB TC,CHANUM
MOVSS TC
HRRI TC,1
;GENERATE CODE FOR "WRITE ADVANCING" (CONT'D)
WADVG5: MOVSI CH,WADV. ;SET UP OP-CODE
IFN ANS74,<
PUSHJ PP,CNVKYB ;SEE IF KEY NEEDS CONVERTING
>
SKIPN TE,WDPITM## ;DEPENDING ITEM?
JRST WADV5A ;NO, SKIP THIS
TRNN TE,-1 ;ARE WE SURE?
JRST WADV5A ;NO
PUSH PP,TC ;SAVE TC NOW
TLNE TE,-1 ; HAVE TO PRESERVE %PARAM+0?
SETOM SAVPR0## ;YES, TELL SZDPVA
HRRZM TE,ETABLA ;LINK IN ETABLA
MOVEI TE,15 ; LOAD SIZE IN RUNTIME AC 15
PUSHJ PP,SZDPVA##
JRST [POP PP,TC ;RESTORE TC
JRST DPPER2] ; AND GO REPORT ERROR
;PUT OUT "MOVEI AC16,LIT"
; PUSHJ PP,WADVV.##
HLRZ CH,CURFIL
ANDI CH,LMASKB
IORI CH,AS.FIL
HRLI CH,MOVEI.+AC16
PUSHJ PP,PUTASY
MOVEI CH,WADVV.##
PUSHJ PP,PUT.PJ
POP PP,TC ;RESTORE TC
JRST OVRPUT ;JUMP OVER PUTOP
;THIS SHOULD NEVER HAPPEN. IF IT DOES, THE PROGRAM SHOULD STILL WORK ANYWAY.
DPPER2: TTCALL 3,DPPEMS ;REPORT PROBLEM WITH DEPENDING VARIABLE
; JRST WADV5A ; AND PRETEND IT'S NOT THERE
WADV5A: PUSHJ PP,PUTOP ;WRITE OUT OPERATOR
OVRPUT: MOVE TE,ERECSZ ;GET SIZE OF OUTPUT RECORD
DPB TE,[POINT 12,TC,11]
TLNN W1,AFTER ;"AFTER ADVANCING"?
TLO TC,1B31 ;NO--SET "BEFORE"
MOVE CH,[XWD AS.XWD,1];CREATE THE XWD
PUSHJ PP,PUTASY
MOVE CH,TC
HRRI CH,AS.CNB
PUSHJ PP,PUTASN
HRRZ CH,TC
JRST WADVG9
;ADVANCING <DATA-NAME> LINES
WADVG6: CAIE TE,TB.DAT
JRST BADMNE
LDB TE,DA.DEF ;IF ITEM IS
JUMPE TE,UNDEFD ; UNDEFINED, TROUBLE
TLNE W1, POSTNG ;WRITE POSITIONING?
JRST WPSGN ;YES GO WORRY OVER IT.
LDB TE,DA.CLA ;IS THIS NUMERIC?
CAIE TE,2
JRST NOTINT
LDB TE,DA.NDP
JUMPN TE,NOTINT
LDB TE,DA.USG
;**; DELETED [166] CAIN TE,D1MODE+1
;**; DELETED [166] JRST WADVG7
CAIE TE,D1MODE+1 ;ITEM 1-WORD COMP [166]
JRST WADVGB ; NO NEED MOVE TO TEMP [166]
MOVE TA,CUREOP ; SEE IF COMP ADV ITEM SUBSCRIPTED [166]
HLRZ EACC,1(TA) ; IF SO NEED TO MOVE TO TEMP [166]
JUMPN EACC,WADVGB ;SUBSCRIPTED ADV ITEM MUST MOVE TO TEMP [166]
HRRZ EACC,1(TA) ; NOT SUBSCRIPTED SAVE NO MOVE NEEDED [166]
JRST WADVG8 ; GET ADV ITEM ADDRESS AND GO [166]
;CHECK POSITIONING ITEM OUT. IT MUST BE AN ITEM DESCRIBED BY "PIC X".
WPSGN: LDB TC, DA.EDT## ;IF IT'S EDITED
JUMPN TC, BADPSN ; COMPLAIN.
LDB TC, DA.USG## ;IF IT'S A ONE
LDB TD, DA.EXS## ; CHARACTER DISPLAY
CAIG TC, DSMODE##+1 ; ITEM,
SOJE TD, WPSGND ; GO ON.
;IT ISN'T, COMPLAIN.
BADPSN: HRRZI DW, E.82 ;POSITIONING ITEM MUST BE A
JRST ADVERA ; NON-EDITED ONE CHARACTER
; DISPLAY DATA ITEM.
BADPNU: HRRZI DW, E.583 ;MUST BE AN INTEGER IN THE RANGE 0 - 3.
JRST ADVERA
WPSGND: MOVEI TE, 1 ;GET A TEMP.
PUSHJ PP, GETEMP
MOVEM EACC, EINCRB## ;SAVE ITS ADDRESS.
MOVSM EACC, ESAVAC##
SETZM EDPLB ;SET UP A ONE
MOVEI TE, 1 ; CHARACTER
MOVEM TE, ESIZEB ; RIGHT JUSTIFIED
MOVE TE, [XWD 7,AS.MSC]
MOVEM TE, EBASEB ; DISPLAY-7 DATA
MOVEI TE, D7MODE ; ITEM IN THE
MOVEM TE, EMODEB ; TEMP.
SWOFF FBNUM!FBSUB;
MOVEI LN, EBASEA ;SET UP THE SOURCE
HRRZ TC, CUREOP
HRLZM TC, OPERND
PUSHJ PP, SETOPN
TSWF FANUM; ;IF IT'S NUMERIC,
JRST BADPSN ; GO COMPLAIN.
PUSHJ PP, MXX.## ;GO DO THE MOVE.
JRST WADV7D ;GO PUT OUT THE WADV.
;GENERATE CODE FOR "WRITE ADVANCING" (CONT'D)
;ADVANCING <DATA-NAME> LINES (CONT'D)
;<DATA-NAME> IS NOT A 1-WORD COMP--CONVERT AND STASH IN TEMP
WADVGB: ; NEED NEW LABEL [166]
MOVEI TE,1 ;GET A SINGLE TEMP WORD
PUSHJ PP,GETEMP
MOVEM EACC,EINCRB
MOVSM EACC,ESAVAC
SETZM EDPLB
MOVEI TE,^D10
MOVEM TE,ESIZEB
MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEB
MOVEI TE,D1MODE
MOVEM TE,EMODEB
;**; AT WADVG6+26 MOVE WADVG7 ADDRESS [163]
;WADVG7: ; [163]
MOVEI LN,EBASEA
HRRZ TC,CUREOP ; GET BACK ADV ITEM ADDRESS [163]
;**; AT WADVG6+30 [163]
;**; DELETED [163] SUBI TC,1
HRLZM TC,OPERND ; GET ADDRESS OF ADV ITEM [163]
PUSHJ PP,SETOPN
SWOFF FASIGN; ;SET "A" IS UNSIGNED
SWON FBSIGN ;SET "B" IS SIGNED
PUSHJ PP,MXX. ;GENERATE A MOVE TO TEMPORARY
WADV7D: MOVE EACC,ESAVAC
HRRI EACC,AS.MSC
;**; AT WADVG6+36 [13]
;**; DELETED [163] JRST WADVG8
;**; DELETED [163] ;<DATA-NAME> IS A 1-WORD COMP
;**; DELETED [163] WADVG7: HRRZ TE,EOPNXT
;**; DELETED [163] HRRZ EACC,0(TE)
WADVG8: MOVSI CH,WADV.
IFN ANS74,<
PUSHJ PP,CNVKYB ;SEE IF KEY NEEDS CONVERTING
>
PUSHJ PP,PUTOP
MOVE CH,[XWD AS.XWD,1]
PUSHJ PP,PUTASY
MOVE CH,[EXP 1B12+AS.CNB]
TLNN W1,AFTER
TLO CH,1B31
TLNE W1, POSTNG ;WRITE POSITIONING?
TLO CH, (1B14) ;YES, SET THE FLAG.
MOVE TE,ERECSZ ;PUT IN RECORD SIZE
DPB TE,[POINT 12,CH,11]
PUSHJ PP,PUTASN
MOVE CH,EACC
WADVG9: PUSHJ PP,PUTASN
IFN ANS68,<
JRST RITGN3
>
IFN ANS74,<
PUSHJ PP,CNVKYA ;SEE IF KEY NEEDS CONVERTING BACK
PUSHJ PP,RDGN10 ;READ UP THRU NEXT OPERATOR
CAIN TE,SPIF.
JRST RITGN4
LDB TE,FI.LCP## ;ANY LINAGE-COUNTER?
JUMPE TE,RITGN5 ;NO
PUSHJ PP,PUTASA ;YES
MOVSI CH,JFCL.## ; NEED A NO-OP INCASE OF PAGE OVERFLOW
PUSHJ PP,PUTASY ; AND NO EOP ROUTINE CALLED
JRST RITGN5
>
;GENERATE CODING FOR "SEEK"
IFN ANS68,<
SEEKGN: PUSHJ PP,SETOP
EQUIT;
MOVE TA,CURFIL ;IF FILE IS
LDB TE,FI.ACC ; NOT RANDOM,
SOJN TE,NOTRAN ; ERROR
MOVSI CH,SEEK##
JRST PUTOP
>
IFN ANS74,<
STRTGN: PUSHJ PP,SETOP
EQUIT;
MOVE TA,CURFIL ;IF FILE IS
LDB TE,FI.ACC ; SEQUENTIAL
JUMPE TE,NOTRAN ; ERROR
PUSHJ PP,CNVKYB ;CONVERT KEY IF NEEDED
MOVE TA,[XWDLIT,,2] ;DO IT BY HAND
PUSHJ PP,STASHP ; SINCE NO MORE UUOS LEFT
LDB TA,[POINT 2,W1,10] ;GET LESS AND GREATER
LSH TA,4 ;BITS 12 AND 13
PUSHJ PP,STASHQ
HLRZ TA,CURFIL ;GET FILE ADDRESS
ANDI TA,LMASKB
IORI TA,AS.FIL
PUSHJ PP,POOLIT
MOVE CH,[MOV##+ASINC+AC16,,AS.MSC]
PUSHJ PP,PUTASY
SKIPN CH,PLITPC
HRRZ CH,ELITPC
SKIPN PLITPC
AOS ELITPC ;NOW ACCOUNT FOR IT
IORI CH,AS.LIT
PUSHJ PP,PUTASN
MOVEI CH,C.STRT##
PUSHJ PP,PUT.PJ
PUSHJ PP,CNVKYA ;CONVERT BACK
PUSHJ PP,RDGN10 ;READ UP THRU NEXT OPERATOR
CAIE TE,SPIF.
JRST RDGN6 ;CHECK FOR USE PROCEDURE
TLNN W1,ATINVK ;ONLY INVALID KEY LEGAL
JRST RDGN6A ;GIVE ERROR MESSAGE
JRST SPIFGN ;OK, GENERATE CODE
>
;GENERATE CODE FOR 'REWRITE'
REWGEN: MOVEI CH,RERIT.
JRST RITGN0
;GENERATE CODE FOR 'DELETE'
DELGEN: MOVEI CH,DELETE##
IFN ANS68,<
JRST RITGN0
>
IFN ANS74,<
MOVEM CH,EIOOP
PUSHJ PP,SETOP ;SET UP OPERAND
EQUIT;
LDB TE,[POINT 3,CURFIL,2]
CAIE TE,CD.FIL ;MAKE SURE ITS A FILE TABLE
POPJ PP, ;NO, GIVE UP BEFORE HARM IS DONE
JRST RDGN0 ;DON'T GENERATE XWD TO FOLLOW
>
;GENERATE CODE FOR 'NO-OP'
IFN ANS74,<
NOOPGN::PUSHJ PP,PUTASA##
MOVSI CH,JFCL.##
JRST PUTASY
>
;THE "DISPLAY" GENERATOR
DISPGN: MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST BADEOP ;NO--TROUBLE
TLNE W1,CONSOL ;"UPON" OPTION USED ?
PUSHJ PP,EDUPON ;YES--CHECK IT OUT
FSTRY: MOVEM EACA,EOPNXT ;POSITION OF LAST OPERAND SEEN INTO EOPNXT
MOVE EACA,EOPLOC ;GET POINTER TO BEGINNING OF TABLE
;NOT TO 1ST USED SLOT
HRRZM EACA,CUREOP ;CURRENT ENTRY BEING USED IN EOPTAB
;IS ONE HELD IN CUREOP.
AOSA EACA,CUREOP ;NOW WE POINT TO 1ST USED ENTRY, 1ST WORD...
GOTMOR: HRRZ EACA,CUREOP ;GET NEXT DEEPEST ENTRY
MOVSM EACA,OPERND ; IN OPERAND TABLE
MOVE EACB,(EACA) ;GET 1ST WORD OF NEXT OPERAND
MOVEI EACA,1(EACA) ;BUMP EACA TO POINT TO SECOND WORD
TLNE EACB,GNLIT ;IS IT A LITERAL ?
JRST DISLIT ;YEP !
;OK, IT'S NOT A LITERAL:
;EITHER IT REQUIRES CONVERSION (& MXTMP. WILL WORRY ABOUT SUBSCIPTING, ETC,)
;OR IT'S DISPLAY-7 OR DISPLAY-6, IN WHICH CASE YOU WORRY ABOUT SUBSCRIPTING.
MOVE TA,(EACA) ;GET OPERAND TABLE-LINK
MOVSM TA,CURDAT ; AND SAVE IT
PUSHJ PP,LNKSET ;CONVERT TO ADDRESS
HRRM TA,CURDAT ; AND SAVE THAT
LDB TC,DA.USG ;GET USAGE OF OPERAND
JRST @DISPDO(TC) ;DO WHAT TABLE SENDS YOU TO DO
DISPDO: EXP ENDTST ; _ 0 TYPE NO YET ASSIGNED
EXP DISPD6 ; _ 1 DISPLAY-6
EXP DISPD7 ; _ 2 DISPLAY-7
EXP STNDRD ; _ 3 DISPLAY-9
EXP STNDRD ; _ 4 1 WORD COMP
EXP STNDRD ; _ 5 2 WORD COMP
EXP DISPFP ; _ 6 COMP-1
EXP STNDRD ; _ 7 INDEX
EXP STNDRD ; _ 10 COMP-3
;"DISPLAY" GENERATOR (CONT'D).
;NOW CALL ON THE MOVE GENERATOR FOR A LITTLE HELP
STNDRD: HRRZ TC,CUREOP
PUSHJ PP,MXTMP. ;MOVE X TO A TEMP., GENERATING CONVERSION
TSWF FERROR ;ANY TROUBLE?
JRST ENDTST ;YES--IGNORE THIS OPERAND
MOVE EACD,TA ;SAVE CALL PARAMETERS
MOVE EACC,TB
STND1: TLNE W1,NOADV ;IS IT 'WITH NO ADVANCING'?
JRST STND2 ;YES--DON'T WORRY ABOUT 'END-OF-LINE' FLAG
MOVE TC,CUREOP ;SAVE ADDRESS OF THIS OPERAND
PUSHJ PP,BMPEOP ;ANY MORE OPERANDS?
TLO EACC,1B<^D18+7> ;NO--SET "END-OF-LINE" FLAG
MOVEM TC,CUREOP ;RESET ADDRESS OF CURRENT OPERAND
STND2: MOVE TA,[XWD XWDLIT,2]
PUSHJ PP,STASHP
MOVE TA,EACC
MOVE TE,ESIZEA ;GET SIZE OF OPERAND
CAIG TE,1777 ;WILL IT FIT IN 10 BITS?
JRST STND3 ;YES
TLZ TA,1B<^D18+7> ;NO--TURN OF 'END-OF-LINE'
MOVEI TE,^D1020 ;CHANGE SIZE TO 1000
STND3: TLZ TA,1777 ;USE SIZE IN 'TE'
TLO TA,(TE)
MOVNS TE
ADDM TE,ESIZEA
PUSHJ PP,STASHQ
MOVE TA,EACD
PUSHJ PP,POOLIT
IFN ANS68,<
HRRZ TE,EMODEA
TSWT FANUM ;NUMERIC IS ALWAYS CONVERTED TO ASCII
>; END IFN ANS68
IFN ANS74,<
HRRZ TE,EMODEB > ;MODE OF ITEM IS IN 'B'
CAIE TE,D6MODE ;SIXBIT IS SPECIAL
SKIPA CH,[XWD DSPLY.+ASINC,AS.MSC]
; MOVE CH,[MOVEI.##+AC16+ASINC,,AS.MSC]
MOVE CH,[DSPL.6##+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
SKIPN CH,PLITPC
HRRZ CH,ELITPC
IORI CH,AS.LIT
PUSHJ PP,PUTASN
SKIPN PLITPC
AOS ELITPC
; HRRZ TE,EMODEB
; MOVEI CH,DSPL.6##
; CAIN TE,D6MODE
; PUSHJ PP,PUT.PJ ;FINISH OFF SIXBIT
SKIPN ESIZEA ;IS OPERAND COMPLETELY OUT?
JRST ENDTST ;YES--LOOK FOR NEXT ONE
MOVE TA,EMODEA ;NO
CAIN TA,D6MODE
SKIPA TA,[EXP ^D1020/6]
MOVEI TA,^D1020/5
HRLZ TA,TA
ADD EACD,TA ;BUMP ADDRESS
JRST STND1
;ITEM TO BE DISPLAYED IS ASCII
DISPD6:
DISPD7: MOVE TC,CUREOP ;SET UP PARAMETERS IN "A"
MOVEI LN,EBASEA
PUSHJ PP,SETOPN
TSWF FERROR ;ANY TROUBLE?
JRST ENDTST ;YES--FORGET THIS OPERAND
TSWT FANUM ;NUMERIC?
TSWT FASUB ;NO--SUBSCRIPTED?
JRST STNDRD ;EITHER NUMERIC OR NOT SUBSCRIPTED
;NON-NUMERIC AND SUBSCRIPTED -- USE "SUBSC." UUO
MOVE TA,CURDAT
HRRZ TB,ESIZEA ;USE INTERNAL SIZE UNLESS
LDB TE,DA.EDT ; ITEM IS
SKIPE TE ; EDITED,
LDB TB,DA.EXS ; IN WHICH CASE USE EXTERNAL SIZE
HRRM TB,ESIZEA
CAILE TB,1777 ;BIG DISPLAY?
JRST DISP7C ;YES-- GO DO IT IN 2 OR MORE STEPS
MOVEI DT,ESAVES
PUSHJ PP,BMPEOP
; TLNN W1,NOADV ; [345] IF NO ADVANCING SKIP OVER LINE END SETTING
SKIPA ; [366] NO MORE ITEMS TO DISPLAY FINISH.
JRST DISP7A ; [366] MORE ITEMS TO DISPLAY
TLNN W1,NOADV ; [366] IF NO ADVANCING, SKIP OVER
; [366]LINE END SETTING
IORI TB,1B<^D18+7>
DISP7A: MOVEM TB,SUBCON
MOVS TC,OPERND
MOVEM TC,CUREOP
PUSHJ PP,SUBSCR
JRST DISP7B ;ALL SUBSCRIPTS WERE NUMERIC LITERALS
HRRZ TE,EMODEA
CAIN TE,D6MODE ;SIXBIT IS SPECIAL
SKIPA CH,[DSPL.6,,SXR]
MOVE CH,[XWD DSPLY.,SXR]
PUSHJ PP,PUTASY
JRST ENDTST
DISP7B: MOVE EACC,TE
HRRI EACC,AS.CNB
MOVS EACD,TE
HRR EACD,EBASEA
MOVE TE,EMODEA ;SINCE CODE AFTER STND2 USES
MOVEM TE,EMODEB ;EMODEB TO CHECK FOR ASCII ITEM
JRST STND2
DISP7C: SUBI TB,^D1020 ;FIRST WE WILL DO 1020 CHARACTERS
HRRZM TB,ESIZEZ ;ESIZEZ = CHARS LEFT TO MOVE
MOVEI TE,^D1020
MOVEM TE,SUBCON ;SET SUBCON TO 1020 CHARS - NO ADVANCING!
MOVS TC,OPERND
MOVEM TC,CUREOP
MOVEI DT,ESAVES
PUSHJ PP,SUBSCR ;CALL SUBSCRIPT ROUTINE
JRST DISP7B ; ALL WERE NUMERIC LITERALS
DISP7D: HRRZ TE,EMODEA
CAIN TE,D6MODE ;SIXBIT IS SPECIAL
SKIPA CH,[DSPL.6,,SXR]
MOVE CH,[XWD DSPLY.,SXR]
PUSHJ PP,PUTASY
SKIPN ESIZEZ ;MORE CHARS TO MOVE?
JRST ENDTST ;NO, DONE WITH THIS DISPLAY
CAIN TE,D6MODE
SKIPA CH,[^D1020/6]
MOVEI CH,^D1020/5 ;NUMBER OF WORDS TO BUMP SAC
HRLI CH,ADDI.+SAC ;GENERATE "ADDI SAC,#WORDS ALREADY DISPLAYED"
PUSHJ PP,PUTASY
HRRZ TE,ESIZEZ ;GET CHARS LEFT TO MOVE
CAILE TE,1777 ;STILL BIG?
JRST DISP7E ;YES--DO ANOTHER ^D1020
;DO THE LAST OF 'EM, SETUP "EOL" FLAG IN AC12 IF NECESSARY
;HAVE TO CHANGE THE SIZE IN LH (AC12) IF DIFFERENT FROM 1020
PUSH PP,CUREOP ;SAVE TO RESTORE AFTER "BMPEOP"
SETZ TC, ;TC= 0 IF WE DON'T WANT EOL AT END
PUSHJ PP,BMPEOP
SKIPA ;NO MORE ITEMS TO DISPLAY
JRST DISP7F ;FINISH UP
TLNE W1,NOADV ;NO ADVANCING?
JRST DISP7F ;YES, DON'T SET EOL FLAG
HRRI TC,1B<^D18+7> ;EOL BIT IN TD
DISP7F: POP PP,CUREOP ;RESTORE CUREOP (THIS OPERAND)
MOVE CH,[TLZ.+SAC,,3777]
PUSHJ PP,PUTASY ;"TLZ SAC,3777" TO CLEAR OLD PARAMETERS
HRLI CH,TLO.+SAC
HRR CH,ESIZEZ ;SIZE LEFT TO DO
IOR CH,TC ;POSSIBLY SET EOF BIT
PUSHJ PP,PUTASY ;"TLO SAC,NEW.PARAMETERS"
SETZM ESIZEZ ;NO MORE CHARS TO MOVE!
JRST DISP7D ; GO DO ANOTHER DSP. UUO
;DO ANOTHER ^D1020 CHARACTER DISPLAY -- SAME PARAMS IN SAC
DISP7E: MOVEI TE,^D1020
MOVN TD,TE ;-CHARS TO MOVE THIS TIME
ADDM TD,ESIZEZ ; HOPEFULLY GET TO LESS THAN 1777 SOMETIME
JRST DISP7D ;GO DO ANOTHER UUO
;DISPLAY A COMP-1 FIELD
DISPFP: MOVE TC,CUREOP
MOVEI LN,EBASEA
PUSHJ PP,SETOPN
TSWF FERROR;
JRST ENDTST
MOVEI TE,5
MOVEM TE,EAC
PUSHJ PP,MXAC.
MOVEI CH,DSP.FP
PUSHJ PP,PUT.PJ
MOVE TC,CUREOP
PUSHJ PP,BMPEOP
JRST DISFP1
SETZM ETEMPC
JRST GOTMOR
DISFP1: MOVEM TC,CUREOP
PUSHJ PP,ASRJ.
MOVSI EACC,446001
HRRI EACC,AS.CNB
MOVS EACD,EASRJ
HRRI EACD,AS.MSC
MOVEI TE,1
MOVEM TE,ESIZEA
JRST STND2
;"DISPLAY" GENERATOR (CONT'D)
;DISPLAY A LITERAL
DISLIT: TLNE EACB,GNFIGC ;IS IT A FIG. CONST.?
JRST DISFC ;YES
MOVEI LN,EBASEA ;NO--SET UP PARAMETERS
HRRZ TC,CUREOP
PUSHJ PP,SETOPN
TSWF FERROR ;ANY TROUBLE?
JRST ENDTST ;YES--FORGET THIS ONE
MOVE TE,[XWD EBASEA,EBASEB] ;MAKE "B" LOOK LIKE "A"
BLT TE,EBASBX
MOVEI TE,D7MODE ;MAKE B'S MODE DISPLAY-7.
MOVEM TE,EMODEB
MOVEI TE,2
MOVEM TE,ADCRLF## ;SEE IF WE NEED CR-LF OF JUST NULL
TLNE W1,NOADV ;IS IT 'WITH NO ADVANCING'?
JRST DISLT1 ;YES--DON'T WORRY ABOUT 'END-OF-LINE' FLAG
MOVE TC,CUREOP ;SAVE ADDRESS OF THIS OPERAND
PUSHJ PP,BMPEOP ;ANY MORE OPERANDS?
AOSA ADCRLF ;NO, ADD CR-LF
DISLT1: SOS ADCRLF ;YES, JUST NULL REQUIRED
MOVEM TC,CUREOP ;RESET ADDRESS OF CURRENT OPERAND
PUSHJ PP,LITD.
SETZM ADCRLF
REPEAT 0,<
MOVS EACD,EINCRA
HRRI EACD,AS.MSC
MOVE EACC,[EXP ^D36B5+AS.CNB]
MOVE TE,ESIZEA
DPB TE,[POINT 7,EACC,17]
JRST STND1
>
MOVE CH,[DSPL.7##+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,EINCRA
ANDI CH,077777
IORI CH,AS.LIT
PUSHJ PP,PUTASN
JRST ENDTST ;SEE IF MORE
;"DISPLAY" GENERATOR (CONT'D)
;DISPLAY A FIGURATIVE CONSTANT
DISFC:
IFN ANS68,<
TLNE EACB,GNTALY!GNTODY ;"TALLY" OR "TODAY"?
>
IFN ANS74,<
TLNE EACB,GNTIME ;"DATE", "DAY", "TIME"
>
JRST STNDRD ;YES--USE STANDARD ROUTINE
TLNE EACB,GNFCS ;SPACE?
JRST FIGC1
TLNE EACB,GNFCZ ;ZERO
JRST FIGC2
TLNE EACB,GNFCQ ;QUOTE?
JRST FIGC3
TLNE EACB,GNFCHV ;HIGH-VALUE
JRST FIGC4
TLNE EACB,GNFCLV ;LOW-VALUE
JRST FIGC5
MOVEI DW,E.184 ;NONE OF THE ABOVE
PUSHJ PP,OPNFAT
JRST ENDTST
FIGC1: MOVE TA,[XWD ASCLIT##,1]
PUSHJ PP,STASHP
MOVE TA,[BYTE(7)" ",0,0,0,0] ; A SPACE
MOVE TC,CUREOP
PUSHJ PP,BMPEOP ;ANY MORE OPERANDS?
MOVE TA,[BYTE(7)" ",15,12,0,0] ;NO, APPEND <CRLF>
MOVEM TC,CUREOP
TLNE W1,NOADV ;NO ADVANCING?
MOVE TA,[BYTE (7)" ",0,0,0,0] ;YES, JUST GET A SPACE THEN
PUSHJ PP,POOLIT
SKIPN EACC,PLITPC
MOVE EACC,ELITPC
SKIPN PLITPC
AOS ELITPC
MOVE CH,[DSPL.7##+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
MOVE CH,EACC
IORI CH,AS.LIT
PUSHJ PP,PUTASN
JRST ENDTST
FIGC2: PUSHJ PP,AZRJ. ;CREATE LITERAL FOR ZERO
HRLZ EACD,EAZRJ
JRST FIGC6
FIGC3: PUSHJ PP,AQRJ. ;CREATE LITERAL FOR QUOTE
HRLZ EACD,EAQRJ
JRST FIGC6
FIGC4: PUSHJ PP,AHRJ.## ;CREATE LITERAL FOR HIGH-VALUES
HRLZ EACD,EAHRJ##
JRST FIGC6
FIGC5: PUSHJ PP,ALRJ.## ;CREATE LITERAL FOR LOW-VALUES
HRLZ EACD,EALRJ##
FIGC6: HRRI EACD,AS.MSC ;FINISH RIGHT HALF OF XWD
MOVE EACC,[EXP ^D36B5+1B17+AS.CNB]
MOVEI TE,1 ;SIZE OF OPERAND IS 1
MOVEM TE,ESIZEA
MOVEI TE,D7MODE ;TURN MODE TO ASCII
MOVEM TE,EMODEA
MOVEM TE,EMODEB
JRST STND1
;"DISPLAY" GENERATOR (CONT'D).
ENDTST: PUSHJ PP,BMPEOP ;ANY MORE OPERANDS?
POPJ PP, ;NO--QUIT
SETZM ETEMPC ;YES--RESET %TEMP BASE
JRST GOTMOR ;CONTINUE PROCESSING
EDUPON: HRRZ TA,(EACA) ;GET TABLE ENTRY FOR "UPON" OPERAND
CAIL TA,700001
CAILE TA,777777 ;BETWEEN COARSE LIMITS OF MNEMONIC TABLE?
JRST BADNEW ;BAD NEWS, NOT A MNEM TABLE LINK
PUSHJ PP,LNKSET ;CONVERT TO REAL ADDRESS
MOVE EACB,1(TA) ;GET MNEMONIC TABLE ENTRY
TLNE EACB,1B21 ;CONSOLE FLAG UP ?
JRST REPOS ;YES HE'S AOK
;REPOSITION POINTER TO LOOK AT LAST
;"WRIT-ABLE" ITEM.
BADNEW: MOVEI DW,E.102
PUSHJ PP,EWARN
REPOS: SUB EACA,[XWD 2,2] ;BACK OFF EACA
CAMN EACA,EOPLOC ;WAS THAT THE ONLY OPERAND?
JRST BADEOP ;YES--TROUBLE
POPJ PP, ;NO--RETURN
;"ACCEPT" GENERATOR
ACCGEN: MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST BADEOP ;NO--TROUBLE
IFN ANS74,<
MOVE TA,-1(EACA) ;GET 2ND OPERAND
TLNN TA,GNFIGC ;FIG. CONST?
JRST ACCGN1 ;NO
TLNE TA,GNTODY ;ONE OF DATE, DAY, OR TIME?
JRST ACCTDY ;YES
ACCGN1:>
TLNE W1,CONSOL
PUSHJ PP,EDUPON
MOVEM EACA,EOPNXT
HRRZ TC,EOPLOC
ADDI TC,1
MOVEM TC,CUREOP
SWOFF FASUB!FALWY0 ;AC'S NOT SUBSCRIPTED AND NOT ZERO
ACEPT1: MOVEM TC,OPERND
MOVEI LN,EBASEB
PUSHJ PP,SETOPN
;**;[430],ACEPT1+2.5,DPL,23-JUN-76
TSWF FERROR ; [430] ANY ERRORS?
JRST ACEPT6 ; [430] YES--DON'T BOTHER WITH THE REST
MOVE TE,[XWD EBASEB,EBASEA] ;SET "A" EQUAL TO "B"
BLT TE,EBASAX
MOVE TA,CUREOP ;IS "B" EDITED?
MOVE TA,1(TA)
IFN ANS68,<
CAIN TA,TALLY.##
JRST ACEPT2
>
PUSHJ PP,LNKSET
LDB TE,DA.EDT
JUMPE TE,ACEPT2
MOVEI TD,EDMODE ;YES--RESET MODE TO
HRRM TD,EMODEB ; 'EDITED'
ACEPT2: HRLZ TC,ESIZEB
PUSHJ PP,BMPEOP
TLO TC,1B<^D18+7>
MOVSM TC,SUBCON
MOVE TC,OPERND
MOVEM TC,CUREOP
MOVE TE,0(TC)
IFN ANS68,<
HRRZ TD,1(TC) ; GET OPERAND ADDRESS [176]
CAIE TD,TALLY.## ; IF TALLY TREAT AS NUMERIC [176]
>
TLNE TE,GNOPNM
JRST ACEP15
;"ACCEPT" GENERATOR (CONT'D).
;FIELD IS ALPHANUMERIC
HRRZ TE,EMODEB
CAIE TE,D7MODE
JRST ACEP10
HRRZ TE,EMODEB
CAIN TE,EDMODE
JRST ACEP10
TSWT FBSUB;
JRST ACEPT5
MOVEI DT,ESAVSB
PUSHJ PP,SUBSCR
JRST ACEPT4
MOVE CH,[XWD ACEPT.,SXR]
PUSHJ PP,PUTASY
JRST ACEPT6
ACEPT4: HRRZM TE,EINCRA
LSH TE,-14
HLLM TE,ERESA
ACEPT5: PUSHJ PP,ACEP20
ACEPT6: PUSHJ PP,BMPEOP ;ANY MORE OPERANDS?
POPJ PP, ;NO--QUIT
MOVE TC,CUREOP ;YES--LOOP BACK FOR MORE
JRST ACEPT1
;"ACCEPT" GENERATOR (CONT'D).
;FIELD IS EITHER ALPHA-EDITED, OR NON-ASCII ALPHANUMERIC
ACEP10: MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEA
MOVE TE,ESIZEA
IDIVI TE,5
SKIPE TD
ADDI TE,1
PUSHJ PP,GETEMP
HRRZM EACC,EINCRA
MOVEI TE,D7MODE
MOVEM TE,EMODEA
PUSHJ PP,ACEP20
SWOFF FASIGN!FANUM;
PUSHJ PP,MXX.
JRST ACEPT6
;FIELD IS NUMERIC OR NUMERIC EDITED
ACEP15: PUSHJ PP,ACEP25
SETZM EAC
SWON FASIGN!FANUM
HRRZ TE,EMODEA
CAIE TE,FPMODE ;SKIP IF IT'S GOING TO RETURN A FLOATING NUMBER
CAIN TE,F2MODE ;OR COMP-2
TRNA ;YES
MOVEI TE,D2MODE ;NO, A 2-WORD COMP
MOVEM TE,EMODEA
PUSHJ PP,MACX. ;GEN CODE TO STORE VALUE IN THE ITEM
JRST ACEPT6 ;AND GO ON TO NEXT OPERAND
;"ACCEPT" GENERATOR (CONT'D).
;CREATE LITERAL AND CALL FOR ALPHANUMERIC
ACEP20: MOVE TA,[XWD XWDLIT,2]
PUSHJ PP,STASHP
HRRZ TA,ESIZEB ;[447] # OF CHARACTERS TO ACCEPT
CAIL TA,2000 ;[447] # .GT. 1023. ?
PUSHJ PP,SUBWRN ;[447] YES, GIVE WARNING AND SET TO 1023.
HRLZ TA,SUBCON
LSH TA,6
HLR TA,ERESA
ROT TA,-6
HRRI TA,AS.CNB
PUSHJ PP,STASHQ
MOVE TA,EBASEA
HRL TA,EINCRA
ACEP21: PUSHJ PP,POOLIT
MOVSI CH,ACEPT.
PUSHJ PP,PUT.LD
SKIPN PLITPC
AOS ELITPC
POPJ PP,
;[447] AREA GREATER THAN 1023 CHARACTERS. GIVE WARNING AND SET TO 1023.
SUBWRN: MOVEI DW,E.590 ;[447] DIAGNOSTIC NUMBER
PUSHJ PP,EWARN ;[447]
HRLZI TA,^D1023 ;[447] 'ACCEPT' ONLY 1023. CHARACTERS
AOS (PP) ;[447] SKIP RETURN
POPJ PP, ;[447]
;CREATE LITERAL AND CALL FOR NUMERIC
ACEP25: MOVE TA,[XWD XWDLIT,2]
PUSHJ PP,STASHP
MOVS TA,SUBCON
TLO TA,1B<^D18+6>
HRRI TA,AS.CNB
PUSHJ PP,STASHQ
HRRZ TA,EMODEA ;ACCEPT FLOATING POINT NUMBER?
CAIE TA,FPMODE
CAIN TA,F2MODE
JRST [MOVSI TA,1B19 ;YES, SET BIT 19 FOR ACEPT.
JRST ACEP26]
HRLZ TA,EDPLA
JUMPGE TA,ACEP26
MOVMS TA
TLO TA,40
JRST ACEP27
ACEP26: HRRZ TB,ESIZEA ;CHECK FOR PPPP...9999
SUB TB,EDPLA
SKIPGE TB ;NOPE
TLO TA,1B18 ;YES- SET BIT 18 (SAVE ONLY FIELD-SIZE DIGITS)
ACEP27: HRRI TA,AS.CNB
JRST ACEP21
;ACCEPT XXX FROM DATE, DAY, OR TIME.
IFN ANS74,<
ACCTDY: EXCH TA,-3(EACA) ;SWAP FIRST WORDS
MOVEM TA,-1(EACA)
MOVE TA,0(EACA) ;GET 2ND WORD
EXCH TA,-2(EACA)
MOVEM TA,0(EACA) ;WE NOW HAVE SWAPPED THE ARGS
JRST MOVGEN## ;AND TREAT AS IF A MOVE
>
;SET UP POINTERS TO OPERANDS
SETOP: MOVEM W1,OPLINE ;SAVE OPERATOR'S LN&CP
SWOFF FEOFF1 ;CLEAR MOST FLAGS
CAME EACA,EOPLOC ;ANY OPERANDS?
JRST SETOP1 ;YES
SWON FERROR ;NO--SET FLAG SO NO CODE GENERATED
JRST BADEOP
SETOP1: HRRZ TA,EOPLOC ;SET TA TO FIRST ONE
ADDI TA,1
MOVEM TA,OPERND ;SAVE
MOVE TA,1(TA) ;RESOLVE INTO ACTUAL ADDRESS
MOVSM TA,CURFIL
PUSHJ PP,LNKSET
HRRM TA,CURFIL
POPJ PP,
;SET UP AND WRITE OPERATOR
PUTOP: HLR CH,CURFIL
AND CH,[XWD -1,LMASKB]
IORI CH,AS.FIL
JRST PUTASY
;CONVERT RELATIVE KEY TO COMP IF REQUIRED
IFN ANS74,<
;CNVKYB - CONVERT KEY BEFORE I/O, NON-SKIP RETURN
;SET LH(WDPITM) = -1 IF KEY IS NOW STORED IN %PARAM+0
CNVKYB: PUSH PP,TA ;SAVE TA
MOVE TA,CURFIL ;RELOAD IT
PUSH PP,CH ;SAVE CURRENT OPERATOR
LDB CH,FI.CKB## ;NEED TO CONVERT KEY
JUMPE CH,CNVKYR ;NO
HRLI CH,EPJPP ;
PUSHJ PP,PUTASY
HRROM WDPITM## ;SET LH(WDPITM) TO -1
CNVKYR: POP PP,CH
POP PP,TA
POPJ PP,
;CNVKYA - CONVERT KEY BACK AFTER I/O, SKIP RETURN ALWAYS
CNVKYA: PUSH PP,TA ;SAVE TA
MOVE TA,CURFIL ;RELOAD IT
PUSH PP,CH ;SAVE CURRENT OPERATOR
LDB CH,FI.CKA## ;NEED TO CONVERT KEY
JUMPE CH,CNVKYR ;NO
PUSHJ PP,PUTASA ;USE SKIP TYPE PUSHJ
LDB CH,FI.CKA
HRLI CH,XPSHJ.##+AC17
PUSH PP,CH
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
POP PP,CH
PUSHJ PP,PUTASY
JRST CNVKYR ;RETURN
;CNVCKC - CONVERT KEY BACK AFTER I/O, NON-SKIP RETURN
CNVKYC: PUSH PP,TA ;SAVE TA
MOVE TA,CURFIL ;RELOAD IT
PUSH PP,CH ;SAVE CURRENT OPERATOR
LDB CH,FI.CKA## ;NEED TO CONVERT KEY
JUMPE CH,CNVKYR ;NO
ADDI CH,1 ;GET NEXT TAG
HRLI CH,EPJPP
PUSHJ PP,PUTASY
JRST CNVKYR ;RETURN
>
;GET FILTAB ENTRY CORRESPONDING TO THE SPECIFIED OUTPUT RECORD
GTFATH: LDB CH,[POINT 3,(TA),2] ;IS THIS A DATA-NAME?
CAIE CH,TB.DAT
JRST NOTREC ;NO--ERROR
LDB TE,DA.DEF ;IS IT DEFINED?
JUMPE TE,NOTREC ;IF NOT, ERROR
GTFAT1: MOVE CH,TA
LDB TA,DA.BRO
JUMPE TA,NOTREC
LDB TE,LNKCOD ;IS FATHER/BROTHER LINK TO DATAB?
CAIE TE,TB.DAT
JRST GTFAT2 ;NO
PUSHJ PP,LNKSET ;YES--CONVERT TO ADDRESS
JRST GTFAT1 ;LOOP TO NEXT
GTFAT2: CAIE TE,TB.FIL ;IS FATHER/BROTHER A FILE?
JRST NOTREC ;NO--ERROR
MOVSM TA,CURFIL ;YES--SAVE LINK
PUSHJ PP,LNKSET ;CONVERT TO ADDRESS
HRRM TA,CURFIL ; AND SAVE THAT
POPJ PP,
;FIND LARGEST DATAB RECORD FOR THIS FILTAB--PUT OPERAND FOR IT INTO "EINTO"
LARGE: PUSHJ PP,LARGER ; FIND LARGEST RECORD [245]
MOVEM CH,EINTO ; STORE INTO EINTO FOR READ OR RELEASE [245]
MOVE TB,EINTR+1 ; FINISH FOR [245]
MOVEM TB,EINTO+1 ; 2ND WORD [245]
POPJ PP, ; [245]
LARGER: MOVE TA,CURFIL ; REPORT WRITER ENTRY GET LINK TO [245]
LDB TA,FI.DRL ; FIRST DATA RECORD
HRRZI TD,0 ;CLEAR SIZE OF LARGEST
LARGE1: MOVE CH,TA ;SAVE DATAB LINK
JUMPE TA,LARGE4 ;MUST BE AN ERROR CASE, NONE THERE
PUSHJ PP,LNKSET
LDB TC,DA.EXS ;GET SIZE OF THAT RECORD
JUMPE TC,LARGE5 ;[474] IF SIZE ZERO TROUBLE
CAIG TC,(TD) ;IS THIS LARGEST SO FAR?
JRST LARGE2 ;NO
MOVE TD,TC ;YES
HRRZM CH,EINTR+1 ; SAVE LARGEST [245]
MOVEM TA,EINTR ; RECORD [245]
LARGE2: LDB TC,DA.FAL ;IF THERE IS NO
JUMPN TC,LARGE3 ; BROTHER, WE ARE DONE
LDB TA,DA.BRO ;GET BROTHER LINK
JRST LARGE1 ;LOOP
LARGE5: MOVEI DW,E.340 ;[474] GET SIZE ERROR MESSAGE
LDB CP,W1CP ;[474] GET CHARACTER POSITION
LDB LN,W1LN ;[474] GET LINE NUMBER
PUSHJ PP,WARN ;[474] PUT OUT MESSAGE AND CONTINUE
LARGE4: MOVEI TA,<CD.DAT>B20+1 ;AIM AT DUMMY
MOVEM TA,EINTR+1 ; [357] KEEP DUMMY DATAB LINK
PUSHJ PP,LNKSET ; & GO ON (ERROR MSG FROM ELSEWHERE)
MOVEM TA,EINTR ; [357] SAVE DUMMY DATAB ADDRESS
LARGE3: MOVE TA,EINTR ; GET ADR OF RECORD [245]
LDB CH,DA.LNC ;GET LN&CP OF LARGEST RECORD [245]
MOVEM CH,EINTR ; SAVE IT [245]
POPJ PP,
;[605] SEE IF THIS IS A VARIABLE LENGTH READ IN WHICH THE DEPENDING ITEM
;[605] IS NOT CONTAINED IN THE RECORD ITSELF
INTERN VLTST,VLTSTN ;[605] SO IT CAN BE CALLED FROM IFGEN
VLTST: SETZM EDEPFT## ;[605] CLEAR THE FLAG WORD
MOVE TA,CURFIL ;[605] GET LINK TO CURRENT FILE TABLE
LDB TA,FI.DRL ;[605] GET FIRST DATA RECORD
VLTST1: JUMPE TA,CPOPJ ;[605] MUST BE AN ERROR CASE, NONE THERE
HRRZ CH,TA ;[605] SAVE DATAB LINK
PUSHJ PP,LNKSET ;[605]
LDB TC,DA.DLL## ;[605] DEPENDING ITEM AT LOWER LEVEL?
JUMPE TC,VLTST9 ;[605] NO, TRY NEXT RECORD
LDB TB,DA.SON## ;[605] FIND THE DEPENDING ITEM
VLTST2: PUSHJ PP,FNDBRO## ;[605] THIS CODE COPIED FROM MOVGEN CODE
SKIPA TA,TB ;[605] FOUND LAST BROTHER
JRST VLTST2 ;[605] NO, LOOP
HRL CH,TA ;[605] SAVE OCCURS ITEM FOR IFGEN
PUSHJ PP,LNKSET ;[605]
LDB TB,DA.SON ;[605] LOOK AT ELEMENTARY ITEM
JUMPN TB,VLTST2 ;[605] THIS ISN'T IT, GO DOWN DEEPER
LDB TB,DA.DEP## ;[605] IS THIS THE DEPENDING VARIABLE?
JUMPE TB,VLTST8 ;[605] ?ERROR--SHOULD HAVE FOUND DEPENDING ITEM!
VLTST3: PUSH PP,TB ;[605] INCASE ALREADY AT THE TOP LEVEL
PUSHJ PP,FNDPOP## ;[605] FIND THE TOP LEVEL
JRST VLTST5 ;[605] MUST BE ALREADY AT TOP LEVEL
POP PP,(PP) ;[605] CLEANUP THE STACK
VLTST4: PUSHJ PP,FNDBRO## ;[605] GET LAST BROTHER
JRST VLTST3 ;[605] NOW LOOK FOR ITS FATHER
JRST VLTST4 ;[605] NO, LOOP
VLTST5: POP PP,TB ;[605] GET BACK THE TOP ITEM
HLRZ TA,CURFIL ;[605] GET TABLE ENTRY FOR CURRENT FILE
CAMN TA,TB ;[605] IS THE DEPENDING ITEM PART OF THE RECORD
JRST VLTST8 ;[605] YES, IGNORE THIS CASE
MOVEM TA,EDEPFT ;[605] SAVE IT FOR AFTER READ
POPJ PP, ;[605]
VLTST8: HRRZ TA,CH ;[605] RELOAD
VLTSTN: PUSHJ PP,LNKSET ;[605] ENTRY FROM IFGEN FOR NEXT BROTHER
VLTST9: LDB TC,DA.FAL ;[605] IF THERE IS NO
JUMPN TC,CPOPJ## ;[605] BROTHER, WE ARE DONE
LDB TA,DA.BRO ;[605] GET BROTHER LINK
JRST VLTST1 ;[605] LOOP
;DIAGNOSTIC ROUTINES
;FILE IS NOT RANDOM
NOTRAN: MOVEI DW,E.205
JRST OPFAT
;IMPROPER "ADVANCING N LINES"
BADLIN: MOVEI DW,E.98
JRST ADVERA
;ADVANCING <DATA-NAME> HAD DECIMAL PLACES
NOTINT: MOVEI DW,E.207
JRST ADVERA
;MNEMONIC-NAME WASN'T A CHANNEL
BADMNE: MOVEI DW,E.98
ADVERA: HRRZ TE,EOPNXT
MOVEI TE,-1(TE)
MOVEM TE,CUREOP
PUSHJ PP,OPNFAT
JRST RITGN3
;NOT WRITING A RECORD
NOTREC: MOVEI DW,E.206
MOVE TE,OPERND
HRRZM TE,CUREOP
JRST OPNFAT
;UNDEFINED DATA-NAME IN "ADVANCING"
UNDEFD: MOVEI DW,E.104
JRST ADVERA
;MISCELLANEOUS CONSTANTS
ADVANC==1B27 ;"ADVANCING" IN GENFIL OPERATOR
AFTER==1B28 ;"AFTER ADVANCING" IN GENFIL OPERATOR
FROM==1B29 ;"WRITE FROM" IN GENFIL OPERATOR
INTO==1B27 ;"READ INTO" IN GENFIL OPERATOR
POSTNG==(1B12) ;"POSITIONING" IN GENFIL OPERATOR
CONSOL==1B27 ;"UPON" FOR DISPLAY, "FROM" FOR ACCEPT
DELETF==1B30 ;"WITH DELETE" IN GENFIL OPERATOR
NOADV==1B28 ;"WITH NO ADVANCING" IN 'DISPLAY' OPERATOR
CHANUM: POINT 3,1(TA),35 ;CHANNEL NUMBER IN MNETAB
EXTERNAL CURDAT,EIOOP,LMASKB
EXTERNAL EINTO,EINTR,OPERND,ESAVAC,EAC,W1LN,W1CP,EPJPP,PUT.EX,PUT.PJ
EXTERNAL EASRJ,EAZRJ,EAQRJ,ERECSZ
EXTERNAL EOPLOC,EOPNXT,CURFIL,CUREOP,OPLINE
EXTERNAL ETEMPC,ELITPC,ESAVAC
EXTERNAL LITLOC,BYTE.W
EXTERNAL SUBCON,DSP.FP
EXTERNAL EBASEB,EMODEB,EDPLB,EINCRB,ESIZEB,ERESB
EXTERNAL EBASEA,EMODEA,EDPLA,EINCRA,ESIZEA,ERESA,EBASAX,EBASBX
EXTERNAL ESAVES, ESAVSB
EXTERNAL AS.FIL
EXTERNAL JRST.,ACEPT.,DSPLY.,RERIT.,WADV.
EXTERNAL PURGE.
EXTERNAL AS.TAG,AS.CNB,AS.MSC,AS.LIT,XWDLIT
EXTERNAL AS.XWD,D1MODE,D2MODE,D6MODE,D7MODE,EDMODE
EXTERNAL ATINVK,ATEND,INVKEY,SPIF.,TCCP,TCLN,EOPCOD
EXTERNAL LNKCOD,TB.DAT,TB.FIL,TB.MNE
EXTERNAL DA.LNC,DA.DEF,DA.USG,DA.NDP,DA.EXS,DA.BRO,DA.CLA,DA.EDT,DA.FAL
EXTERNAL FI.ACC,FI.ERM,FI.DRL,FI.RKY,FI.SKY
END