.TITLE REPORT .IDENT /290783/ .ENABL LC ; ; Written by Ray Di Marco ; 5-Apr-82. ; ; ; Version 040582/04. ; ; ;---------------------------------------------------------------------------- ; ; This is the main module for the database management program REPORT, that ; allows the user to produce reports using data that is stored in the ; database records. The program is used to output reports; it takes as ; input a FORMAT file that determines the layout of the report and a sorter ; data file which determines which records are to be used to produce the ; report and the order in which they are to be processed. Note that the ; normal procedure is to use the SELECT cusp to load a sorter data file with ; record fileds; this file is then passed to the SORTER cusp to reorder the ; selected fields, and is then passed onto this program to output a proper ; report. The program prompts the user for the following upon activation- ; ; 1) TEMPLATE fl name; database template, optional ; 2) FORMAT file name; this determines report layout ; 3) SORTER file name; this determines record processing order ; 4) REPORT file name; output is dirrected to this file ; ; The program can be envoked as a CUSP from a menu program, and will accept ; the name of the FORMAT, SORTER and REPORT file from the command lines ; passed in core common. ; ; The FORMAT file can contain instructions intepreted by REPORT. While the ; instruction set is small, it is more than adequate for writing the small ; programs needed adequately layout reports. Instructions are available for ; performing tests, accessing record data and interacting with an operator ; via the terminal. ; ; The module must be linked with the user template and the database library ; to produce a REPORTer customized for the target database. ; ; ; ****************************************************************** ; **** See example FORMAT files at end of documentation section **** ; ****************************************************************** .SBTTL Modifications ; ; 18-Jun-82 --> /02 ; ; Number of changes made to increase program flexibility and utility, and code ; slightly re-arranged to conserve memory usage. Changes made are as follows ; ; Variables G-Z initialized with data passed by SELECT via header ; block of SFL file; variables A-F still initialized as NULLs. The ; other variables are initialized as follows ; G ENTSIZ ; H NUMENT ; I-R N0-N9 ; S-W D0-D4 ; X-Z L0-L2 ; ; ; Modified ..DATA routine to allow FIELD NAME to be terminated by ; delimiters other than the angle brackets. This involved rewritting ; the routine completely; the following constructs are now allowed ; ; $ returns DATA ; $ returns DATA ; $ ; ; where the Ts mark the desired TAB points; is a ruler is defined a ; TAB is converted to number of spaces to fill output line upto next ; defined TAB POINT; if no ruler is defined (or if a NULL ruler is ; defined), TABs are output as normal. The is ignored and the ; marks the end of the command. ; ; ; To conserve memory used, rearranged code and data structure for ; variables so that some initialization code overlays the buffers for ; variables A and F. This was done to ensure that the program SIZE ; remained the same. Also added ...DTA routine to convert binary data ; to ascii so that could be used by both INITIALIZATION code and ; ..DATA routine. ; ; ; ; 25-May-83 --> /03 ; ; Use ABORT macro/routine to trap errors so that now dump out part of the ; FRM file when an error occurs. ; ; Add in command of form ; ; $:X ; ; to position report stream to column equivalent to ascii value of X. Note ; that the left most column is number 1 (and is equivalent to ^A) ; ; ; 29-jul-83 --> /04 ; ; Allow $Iv command within $<> (ie get data) command. This allows the ; construct ; $<$IA> ; ; to be used to get data from record held in field whose name is in variable ; A. Changed ..DATA routine decode table. ; ; Fix bug in VARINT routine that caused crash if SFL file header block not ; properly initialized. (limited size of L0-L3 data copied into X, Y, Z.) ; ; Change ..NEXT routine so that data in SFL record loaded in variable F ; when $N performed. ; ; .SBTTL Documentation .IF EQ,-1 Upon activation, the program will prompt the user for the following items of information. Note that if the program is envoked as a CUSP from a menu, some of this data may be passed via core common. DB Template : This question is only asked if the user's database template was not linked in when the program was linked. In response to this question the user must specify the name of the file that contains the template (in .SAV) format for the user database. Format File : REPORT effectively inteprets a small user program. This program consists of simple instructions that are contained in the format file whose name is given in reply to this prompt. Sorter File : It is generally desired when using database records to produce reports to access then in a specific order (viz alphabetic order of names, lenght of employment etc). This is most easily achieved by using the SELECT cusp to extract the 'ordering' data and placing it into a sorter data file. Such a file consists of the ordering data and the number of the record from which it was extracted. The sorter file is then sortered, and is then used as input to REPORT. Report reads in one sorted entry at a time, and sets up the database record associated with the entry for processing. Output File : REPORT directs all output to one of a limited number of output streams. The file whose name is entered in reponse to the question becomes the default output stream, and all output, unless specifically directed elswhere, is sent to this file. Once these questions are answered, the program opens the FORMAT file, the sorter work file, and the database (associated with the template linked in when REPORT was built) for input. The report file is openned (created) for output. The input and output streams are then assigned with the FORMAT and REPORT files respectively, after which REPORT procedes to transfer characters from the input to the output stream. While most characters are transfered dirrectly from the input to the output streams, three characters are of special significance in that they modify the 'value' of the next character in the input stream. The following three sequences of characters are of special significance The sequence of characters ^X is equivalent to control-X The sequence of characters _X is equivalent to the character X The sequence of characters $X is called command-X Note that the uparrow, dollar and underline characters must be preceded by an underline if it is desired to include then in the format file for other purposes. The detection of a command character (ie a $X sequence) is used to envoke the FORMAT FILE PROCESSOR to perform a special function. It is via the means of command characters that database data is extracted, conditional braching implemented and repeat loops set up. Prior to detailing the command characters available the an number of concepts must be introduced. The REPORT program allows input and output to be dirrected to any one of 28 different entities. Each of these entities is identified by a unique letter. The input stream may be assigned to any of the following entities ! ... FORMAT file @ ... user's terminal A-Z ... internal variables and the output stream to any of the following ! ... REPORT file @ ... user's terminal A-Z ... internal variables Initially, and prior to the start of each new pass (see later), the input and output streams are assigned to the FORMAT and REPORT files respectively. The assignment (during a pass) of the output stream to the REPORT file or terminal causes all subsequent output to be appended to any that was already been sent to that entity, whereas the assignment of a variable to the output stream causes any prior output to be erased; output dirrected to a variable is stored as a .ASCIZ string, and cannot be longer than 255 bytes. The process of assigning the input stream to the FORMAT file, when when done during a pass, will not cause the format file to be rewound; characters continue to be obtained from where input was interrupted. The assigning of the input stream to the user console causes the user to be prompted for a line of input (terminated by a CR), which is stored in an internal pseudo variable, to which the input stream is then assigned. Assigning the input stream to a variable causes input to commence with the first byte in the variable. Once all data in the variable is exhausted, the input stream is automatically reassigned to the format file. Attaching a variable to an input stream does not destroy its contents. The FORMAT file is composed of three sections. These sections are termed the header, body and trailer respectively, and are delimited by special command characters. These sections correspond approximately to the sections on a report page, as a report page normally consists of headings, data from one or more related records, and optionally a trailer. At any instance, the report writer can be said to be in one of three phases, depending upon which section of the format file is being 'executed'; the three phases in turn are said to make up a pass. The FORMAT FILE INTERPETOR respondes to command characters differently, depending upon which phase it is in; the phase also effects the action to be undertaken upon the occurance of various significant events (ie end of data). While the header is being processed, phase 1 is said to be active, which means that it is the phase active when the program is first started, and is re-entered at the start of each processing pass. Upon entry to phase 1, the format file is re-wound, the I/O streams reassigned to the FORMAT and REPORT files respectively, the page number increased and all output suppression flags cleared. The pass is then initiated by transfering the input stream characters to the output stream; phase 1 is terminated and phase 2 activated when a $\ command character is encountered in the input stream. Note that if the End Of Data condition (ie all sorter data file entries have been processed) is true upon entry to phase 1, the program terminates by closing the report file and exitting. Phase 2 is entered dirrectly from phase 1, upon the detection of a $\ command character. Phase 2 is used to produce the body of a report page, using data extracted from one or more (related) database records. For example, in a component inventory system, it could be desired to output the name and quantity in stock of all components, such that all items of the same type (ie resistors, transistors etc) are output on the same page. For this reason, special commands are available in phase 2 to load the next record scheduled for processing, carry out conditional tests (ie if outputting the page on transistors, we must ensure that we start a new page if the next record is associated with say diodes) and detect the End of Data condition. The testing commands available allow the user to conditionally terminate phase 2; the manner in which the termination is implemented is detailed in the explanation of the $M (mode selection) command. Phase 2 is terminated by either a $* command, which marks the start of the trailer (optional), or a second $\ command, that marks the end of the format file, and causes phase 1 to be reentered. Phase 3 is used to produce the report page trailer, and is entered from phase 2 upon detection of a $* command. It is terminated by a $\ command, after which phase 1 is re-entered. The trailer is optional, and need only be included for special reports (eg the page number is at the bottom of the page). When using a trailer section, it is necessary to select phase 2 termination mode 2! The command characters that invoke the FORMAT FILE INTERPRETOR will now be detailed. Remember, that all other characters (except for the command characters and those used as command arguments) are simply copied from the input to the output streams. The $C command character causes all input upto and including the next LF to be ignored. This character is provided to allow comments to be iserted in the format file (if desired). The $; command character toggles an internal flag, that when set, causes all REPORT file output to be suppressed, but does not effect any other output. This command character is useful in formatting complexe command sequences, in that it allows embedded comments to be included. Note that no other input or output stream entity is effected other than the report file. REPORT file output is enabled upon encountering a second $; command; the second such character as well as re-enabling output is treated as a $C, which means that all subsequent characters upto and including the next are ignored. The $P character is replaced by a five digit page number. The page number is incremented each time the FORMAT file header section is entered. The $D character is replaced by an eight character string that represents the current system date. The $< character is replaced by the contents of the field (for the record currently loaded) whose name follows the $< in the input stream, and is terminated by a > or < delimiter. Using the first delimiter causes dirrect substitution, while the second delimiter causes all trailing spaces to be trimmed from the field contents prior to the substitution. The commands characters $ $ $ in a format file will be replaced by the contents of the NAME, AGE and SEX fields for the currently loaded records. Ascii type fields are inserted as stored in the database, numeric fields a 5 decimal digits and date fields as an 8 character string. The $N command causes the next record that has to be process to be loaded. It should only be used in the phase 2 part of the format file. If all records have been processed, the End of Data flag is asserted, and this command is subsequently ignored. Upon End of Data, phase 2 may be terminated, or processing can continue, thereby repeating the last record that was loaded. The $I and $O sequences are used to assign the input and output streams (respectively) with the entity whose id is the next character in the input current input stream. For example, the command $O@Please say something: $OA$I@$I!$O!$C $O@I believe you said "$IA" $I!$O! will cause REPORT to prompt the user for console input and then echo it back. The valid entity identifiers are @ for terminal, ! for format/report files and the letters A-Z for the 26 internal literal variables. The first $\ character encountered marks the boundary between phase 1 and 2 code, while the second marks the end of the format stream, and causes phase 1 to be restarted. The meaning of the $* sequence depends upon which phase is active. In phase 1, a $* sequence marks the point at which the phase 1 code is to be re-entered, ans is used to ensure that initialization commands and comments are the start of the file are ignored on all but the first pass. In phase 2, the $* sequence indicates the start of the trailer section. The $M command is recognized only in phase 1, and is generally included in as part of the once-through initialization commands. The command is followed the desired mode character, that can be either a 1 or a 2, that determines what action is to be taken when a conditional phase 2 exit test suceeds, and phase 2 has to be terminated. (The conditional test commands are described below.) Mode 1 is the default, and when active, causes phase 2 to be exitted immediately by causing phase 1 to be entered. This means that outputting to the current report page is immediately stopped. Selecting mode 2 termination causes a more complexe procedure to be initiated to exit phase 2, and is used when it is desired to always include a page trailer. If mode 2 is selected, a terminate phase 2 request is handled by setting an internal flag, and then continueing processing the format file normally. The setting of the specail internal flag causes all report file output, other than the and characters, to be discarded, and the $N command to be treated as a nop. Report file output is re-enabled upon detection of the $* sequence that marks the start of the trailer section. Three conditional phase 2 termination commands are available in phase 2 to terminate upon a given condition. The manner in which the phase is actually terminated depends upon the mode currently selected via the $M command. The $E command causes termination if the last $N command set the End of Data flag, indicating that all records have been processed. The $= and $# commands cause phase 2 termination if the contents of two variables are equal and not equal respecitely. The varaiable names must dirrectly follow the command characters. Below are a number of format programs that can be used to extract data from a component data base and used to produce reports. It is hoped that these will clarify the meaning of the command characters, and aid the user in designing format files suited to his own application. Note that is assumed that one component is stored per record. $C Selected records are output one per line, without any headings or $C divisions. It is assumed that SELECT and SORTER were used to sort $C components by their inventory code. $C $*$\$C $N$E $\ $C This format file outputs the TYPE, CODE, number INSTOCK and COMMENTS for $C components in an inventory database. It is assumed that the sorting was $C done via the TYPE fields, so that records for the same type of components $C will be processed sequentially. A maximum of five components are displayed $C per page, but only if they are of the same type. Each page has a header $C that includes the name of the person to whom the report is to be sent, and $C a trailer that indicates which type of component is displayed on the page. $C $M2 select mode 2 $O@To whom is this report to be addressed: $OT$I@$O! get recievers name $*$C -- header rentry -- ^L$C -- output FF -- To: $IT Date $D Component stock report. Page $P ____________________________________________________________________________ $\$C -- end of header -- Type Inventory Currently Comments number in stock $; $N$E$OA$$O! $; $ $ <$INSTOCK> $$O!$#AB $; $ $ <$INSTOCK> $$O!$#AB $; $ $ <$INSTOCK> $$O!$#AB $; $ $ <$INSTOCK> $$O!$#AB $; $ $ <$INSTOCK> $ ascii conversion ; .GLOBL $$FORM ; needed by DBS support rortines .GLOBL FORM$$ ; address of FDT .GLOBL DBSLDR ; template loader ; .GLOBL LOCFLD ; DBSSPT locate field .GLOBL FILINT,FIL.DR ; DBSSPT record I/O .GLOBL CON.ST,CON.CO,CON.LI,CON.EX ; CONIO console I/O ; .GLOBL RPTNME,RPTINT,RPTEND,RPTOUC,RPTFLG ; RPTFIO .GLOBL FRMNME,FRMINT,FRMRST,FRMINC,FRMMRK ; FRMFIO .GLOBL SFLNME,SFLINT,SFLRST,SFLINP,SFLPAR ; SRTFIO ; ; .SBTTL PSECT Declaraions ; ; ; The following defines the ordering of the PSECTs used in this module. ; The INTOVL psect is special in that it holds the initialization ; routines and is also ovelayed with the data structure needed to ; support the variables ; .PSECT CODE ; code section .PSECT DATA ; data section .PSECT INTOVL,RW,I,GBL,REL,OVR ; open special PSECT ; ; ; The VAR$$$ symbol marks the start of the INTOVL psect; this ; symbol is used later to position code and data structures ; in the section. The variables A-Z are positioned with A ; starting at VAR$$$ and the others at intervals of 256 bytes. ; Any code must be reside with the bounds of a variable, and ; must not overlay the first word of the variable (ie any ; initialization routine overlaying the data structure cannot ; be more than 256-2 bytes in size. ; .PSECT INTOVL ; open section VAR$$$: ; start of section ; ; .PSECT CODE ; open code area ; ====== ==== ; ; ; ; .SBTTL Macro Definitions ; ; The following two macros are equivalent to RT-11s .PRINT and .GTLIN emts. ; .MACRO PRINT STR=R0 .GLOBL CON.LO MOV STR,R0 CALL CON.LO .ENDM PRINT .MACRO GTLIN BUF=R0,STR .IF NB,STR .GLOBL CON.LO MOV STR,R0 CALL CON.LO .ENDC MOV BUF,R0 .GLOBL CON.LI CALL CON.LI .ENDM GTLIN ; ; The following macros are used to abort program execution after typing out an ; error message, and to decode the character in R0 (see DECODE routine). ; ; ABORT is used to abort execution if CND is true; MES is printed out ; .MACRO ABORT MES,CND,FILERR=NO,?LB,?LC .IF NB,CND B'CND LB BR LC LB': .ENDC .IIF IDN,FILERR,NO, JSR R1,ABORT .IIF DIF,FILERR,NO, JSR R1,ABORTF .ASCII /'MES'/<200> .EVEN .IIF NB,CND, LC': .ENDM ABORT ; .MACRO DECODE TABLE MOV #TABLE,R1 CALL DECODE .ENDM DECODE ; ; The following two macros are used to output and input to the currently ; active I/O streams. ; .MACRO .OUTPUT CHAR .IF B, CALL @OUTVEC .MEXIT .ENDC MOV R0,-(SP) .IRP X, MOVB X,R0 CALL @OUTVEC .ENDR MOV (SP)+,R0 .ENDM .OUTPUT .MACRO .INPUT CALL @INPVEC .ENDM .INPUT ; .SBTTL INITIALIZATION SECTION ; ; Ask user to enter the name of the FORMAT, input and output files. Note that ; we initialize CONIO in case the answers are being passed to us in core ; common. Note that if $$FORM is zero, then user template was not linked ; in, in which case must load it ourselves. ; ; To preserve memory, this initialization code resides ; in a special PSECT that overlays the buffer space used ; by the VARIABLES; This routine resides within the buffer ; area of variable A. ; .PSECT INTOVL,RW,I,GBL,REL,OVR ; open special PSECT ; ====== ====== . = VAR$$$ + <<'A-'A>*256.> ; start of variable A .BLKW 1 ; first word reserved ; START: CALL CON.ST ; initialize TTY interface PRINT #7000$ ; identify self TST $$FORM ; have a template? BNE 100$ ; yes -> skip GTLIN #TMPBUF,#7010$ ; get name of 'TPL' file MOV #TMPBUF,R0 ; R0 -> name CALL DBSLDR ; load database MOV R0,$$FORM ; setup database pointer 100$: GTLIN #FRMNME,#7100$ ; get name of 'FRM' file GTLIN #SFLNME,#7110$ ; get name of 'SFL' file GTLIN #RPTNME,#7120$ ; get name of 'RPT' file ; ; Its time to initialize all the input and output streams. This is hard work ; when there are so many. ; CALL FRMINT ; format description file CALL SFLINT ; initialize sort file CALL RPTINT ; initialize report file CALL IOVRST ; initialize i/o streams CALL FILINT ; open data base CALL VARINT ; initialize variables JMP LOOP ; start processing loop ; .NLIST BIN 7000$: .ASCIZ /Report RDM290783/ 7010$: .ASCII / DB Template: /<200> 7100$: .ASCII / Format File: /<200> 7110$: .ASCII / Sorter File: /<200> 7120$: .ASCII / Report File: /<200> .EVEN .LIST BIN ; .PSECT CODE ; open CODE area ; ====== ==== ; .SBTTL Management Code LOOP ... Process Management Code ; ; ; We loop here untill all records selected have been processed. When all ; records have been processed we close out the report file and exit. Untill ; that time though we have quit a bit of work to do. Start of by restting the ; various parameters needed in the loop. ; LOOP: CLR PAGNUM ; initialize page number CLR ENTNUM ; initialize entry number CLR F.REPT ; clear REPEAT RECORD flag ; ; At the start of each loop we reset the I/O streams and increment the page ; number; then if still have more records we load in the next one and process ; it. ; 100$: CALL IOVRST ; reset I/O vectors CALL FRMRST ; reset FORMAT file CLR F.NEWP ; clear NEW PAGE WANTED flag CLR RPTFLG ; allow report file output CLR CHRCNT ; reset char/line counter INC PAGNUM ; start of a new page CALL ..NEXT ; load in next record to process BCS 500$ ; no more -> exit MOV #1,F.REPT ; discard first $N command CALL PHASE1 ; process new record BR 100$ ; time for next record 500$: CALL RPTEND ; close out report file JMP CON.EX ; exit time ; ; .SBTTL Routine - "PHASE1" ... Supervises phase 1 (headings etc) ; ; ; Use 700$ to decode format file and envoke required routines. ; PHASE1: .INPUT ; get next input character DECODE 700$ ; decode via 700$, not found = 600$ BR PHASE1 ; loop ; ; ; Actioning routines 500$ envoked to terminate phase 1 ; 570$ envoked if character to be ignored ; 600$ envoked if character not in table ; 500$: ADD #2,SP ; discard PHASE1 return address JMP PHASE2 ; enter phase 2 processing 570$: RETURN ; ignore character 600$: JMP @OUTVEC ; send character to output stream ; ; ; Table used to decode input. Call routine when encounter char. ; 700$: .WORD '\+200, 500$ ; end of phase 1 .WORD '*+200, FRMMRK ; mark format file rewind point .WORD 'M+200, ..EPMD ; Select phase 2 exit mode .WORD ')+200, ..SEND ; send output to terminal (special) .WORD ';+200, ..SUPP ; suppress report file output .WORD 'C+200, ..COMM ; comment .WORD 'D+200, ..DATE ; output date .WORD 'P+200, ..PAGE ; output page .WORD 'O+200, ..DIRO ; dirrect output to .WORD 'I+200, ..DIRI ; dirrect input requests to .WORD 'R+200, ..RULE ; define RULER .WORD ':+200, ..POSN ; position cursor .WORD 'N+200, 570$ ; ignore NEXT command in phase 1 .WORD '<+200, ..DATA ; get field data .WORD 0, 600$ ; all other characters -> 600$ ; ; .SBTTL Routine - "PHASE2" ... Supervises phase 2 (body of text) ; ; Use 700$ to decode format file and envoke required routines. ; PHASE2: .INPUT ; get next input character DECODE 700$ ; decode via 700$, not found = 600$ BR PHASE2 ; loop ; ; Actioning routines 500$ envoked to terminate phase 2 ; 570$ envoked if character to be ignored ; 600$ envoked if character not in table ; 500$: ADD #2,SP ; discard PHASE2 return address 570$: RETURN ; return to caller 600$: JMP @OUTVEC ; send character to output stream ; ; Table used to decode input. Call routine when encounter char. ; 700$: .WORD '\+200, 500$ ; terminate phase 2 .WORD 'E+200, ..EPEF ; check for EOD .WORD '=+200, ..EPEQ ; check for variables .EQ. .WORD '#+200, ..EPNE ; check for variables .NE. .WORD '*+200, ..EPTL ; start of trailer section .WORD ';+200, ..SUPP ; suppress report file output .WORD 'C+200, ..COMM ; comment .WORD 'D+200, ..DATE ; output date .WORD 'P+200, ..PAGE ; output page .WORD 'O+200, ..DIRO ; dirrect output to .WORD 'I+200, ..DIRI ; dirrect input requests to .WORD 'R+200, ..RULE ; define RULER .WORD ':+200, ..POSN ; position cursor .WORD 'N+200, ..NEXT ; load in next record .WORD '<+200, ..DATA ; get field data .WORD 0, 600$ ; all other characters -> 600$ ; .SBTTL Action Routines "..EP??" ... special phase 2 exits ; ; ; These routines are supplied to allow phase two to be exitted under various ; contions and in either one of two ways. Normally phase 2 is exitted when ; the end of the input file is reached. This may not always be desired, so ; these routines allow phase 2 to be conditionally terminated if 1) all ; entries in the sort file have been processed or 2) two variables are or are ; not equal. The user also has the option of specifying if the phase is to be ; immediately exitted by returning to the main loop supervisor, of if the end ; phase is to be accomplished by simply discarding report file output. ; ; This routine allows phase mode to be selected. ; ..EPMD: .INPUT ; get selected mode SUB #'1,R0 ; mode 1 == 0 MOVB R0,F.EPMF ; set up mode flag RETURN ; exit ..EPTL: CLR F.NEWP ; re-enable output RETURN ; exit ; ; These routines allow the phase to be conditionally exitted. ; ..EPEF: TST F.EOD ; EOF? BNE ENDP ; yes -> end phase RETURN ; no -> continue ..EPEQ: CALL COMPAR ; Variables equal? BEQ ENDPR ; yes -> end phase RETURN ; no -> continue ..EPNE: CALL COMPAR ; Variables not equal? BNE ENDPR ; yes -> end phase RETURN ; no -> continue ; ; This routine exits the phase if the F.EPMF is not asserted, and ; by disabling report file output if it is. ; ENDPR: MOV #1,F.REPT ; must repeat this record ENDP: MOV #1,F.NEWP ; no more output on this page TST F.EPMF ; check mode flag BNE 1000$ ; mode <> 0 -> skip ADD #2,SP ; clear phase 2 return address 1000$: RETURN ; all done ; .SBTTL Action Routine '..SUPP' ... toggle report suppress flag ; ; This routine toggles the RPTFLG. If the flag is set, all report ; file output is discarded. Note that a second call will re-enable ; output, but not untill the next LF is detected in the input stream. ; ..SUPP: COM RPTFLG ; flip bits in report flag BEQ ..COMM ; just cleared -> treat as comment RETURN ; exit ; ; .SBTTL Action Routine '..COMM' ... Comment ; ; Discard all input untill hit end of comment marker, a 'LF'! ; ..COMM: .INPUT ; get a character CMP R0,#12 ; hit a 'LF'? BNE ..COMM ; no -> loop RETURN ; loop ; ; .SBTTL Action Routine '..SEND' ... Send output to terminal ; ; All characters upto but excluding terminator are to be sent to terminal. ; ..SEND: .INPUT ; get character CMP R0,#'$+200 ; terminator? BEQ 1000$ ; yes -> skip CALL CON.CO ; output BR ..SEND ; loop 1000$: RETURN ; exit ; ; .SBTTL Action Routine "..PAGE" ... Output page number ; ; ; This routine is called to output the current page number. It does ; this by converting PAGNUM into a .ASCIZ string stored in the TMPBUF ; buffer and telling OUTBUF to output the buffer. ; ..PAGE: CNAF SSSSD,STRING=#TMPBUF,NUMBER=PAGNUM CLRB (R1) ; place @EOS MOV #TMPBUF,R0 ; R0 -> buffer JMP OUTBUF ; output buffer ; ; .SBTTL Action Routine "..DATE" ... Output date ; ; This routine is called to output the current system date to the ; output stream. The date is setup by VARINT in DATEBF in ASCIZ ; format at initialization time. ; ..DATE: MOV #DATEBF,R0 ; R0 -> date buffer JMP OUTBUF ; empty buffer ; .SBTTL Action Routine "..NEXT" ... load next record ; ; ; This routine is called to load the record associated with the next sort ; file entry. The F.REPT flag is set causes the last record to be repeated; ; this flag is set by the condtional phase 2 terminating routines when the ; phase was exitted prior to processing the record. The routine will set the ; F.EOD flag and return with the C flag set if all records have been ; processed. Note that if the F.NEWP flag is set, the routine is equivalent ; to a NOP, in that it exits immediately. ; ..NEXT: TST F.NEWP ; F.NEWP flag set? BNE 700$ ; yes -> exit immediately TST F.REPT ; have to repeat record? BEQ 1000$ ; no -> skip CLR F.REPT ; clear flag, we are repeating 700$: RETURN ; exit, all done. ; 1000$: CMP ENTNUM,SFLPAR+2 ; done all entries BHIS 2000$ ; yes -> abort INC ENTNUM ; doing next entry MOV #2,R1 ; R1 = number bytes to read MOV #TMPBUF,R0 ; R0 = buffer CALL SFLINP ; read in next entry MOV SFLPAR,R1 ; R1 = entry size SUB #2,R1 ; R1 = number data bytes MOV #VAR$$F,R0 ; R0 -> buffer CALL SFLINP ; input data into variable F CLRB VAR$$F(R1) ; insure string terminated MOV TMPBUF,R0 ; R0 = number of record associated to CALL FIL.DR ; read record into memory BCC 700$ ; all ok -> skip ABORT <..NEXT:record read failure!> ; 2000$: MOV #1,F.EOD ; indicate EOF detected SEC ; set fail flag RETURN ; exit ; .SBTTL Actioning Routine - '..RULE' ... Define a RULER ; ; ; This routine allows the user to specify a ruler. The input syntax is ; ; $R....T......T..........T..... ; ; where the . represents a character position on a line ; the T represents a character position that is a TAB point ; the terminates the input (the is ignored) ; ; This routine sets up the RULTAB with the character count of each TAB ; point; these counts are stored as words and a NULL terminates the ; table. ; ..RULE: .PUSH ; save MOV #RULTAB,R5 ; R5 -> first ruler table entry MOV #32.,R4 ; number of allowed tab points CLR (R5) ; initialize first tab count 40$: .INPUT ; R0 = character DECODE 700$ ; decode input, (.=100$ T=140$) BR 40$ ; loop 100$: INC (R5) ; increase count 110$: RETURN ; exit 140$: CALL 100$ ; increase count MOV (R5)+,(R5) ; R5 -> next counter SOB R4,110$ ; ok -> skip 170$: ABORT <..RULE:invalid RULER definition!> ; ; Get here when LF encountered. ; 500$: ADD #2,SP ; clear DECODE address CLR (R5) ; terminate TAB counts .POP ; restore 600$: RETURN ; all done ; ; Table used to decode RULE input ; 700$: .WORD 12,500$ ; LF -> terminate ruler .WORD 15,600$ ; ignore CR .WORD '.,100$ ; '. -> spacer .WORD 'T,140$ ; 'T -> define TAB point .WORD 00,170$ ; all others illegal ; .SBTTL Routine - "..POSN" ... position cursor ; ; This routine will output enough spaces (if possible) to insure that the ; rest of the output starts at the column equivalent to the ascii value ; of the next input character. ; ..POSN: .PUSH ; save CMP OUTVEC,#OUTPUT ; outputting to report file? BNE 7000$ ; no --> skip .INPUT ; R0 = column number MOV R0,R2 ; R2 = desired column SUB CHRCNT,R2 ; R2 = amount padding needed BLE 7000$ ; skip if none needed MOV R0,CHRCNT ; adjust character count MOV #40,R0 ; R0 = pad character 2200$: CALL RPTOUC ; output number ... SOB R2,2200$ ; ... of needed spaces 7000$: .POP ; restore RETURN ; all done ; .SBTTL Action Routine - "..DATA" ... output field data ; ; We have to output the contents of the field whose name follows in the file. ; The field name is terminated with a delimiter from table 70$. Some of these ; delimiters are used TRIM, RIGHT JUSTIFY, LEFT JUSTIFY etc the data. ; ; Build up field name in TMPBUF; when encounter a DELIMITER that ; is in 70$ table control passes to appropriate code that places ; desired data in TMPBUF, trims, justifies etc and then exits ; by jumping to 60$, which causes the data to be output. ; ..DATA: .PUSH ; save MOV #TMPBUF,R5 ; R5 -> buffer 20$: .INPUT ; get next input character DECODE 70$ ; Decode, (not DELIMITER->40$) BR 20$ ; loop ; 40$: MOVB R0,(R5)+ ; save character CLRB (R5) ; terminate NAME string RETURN ; get next character in name ; 60$: ADD #2,SP ; discard DECODE return address .POP ; restore MOV #TMPBUF,R0 ; R0 -> data JMP OUTBUF ; output buffer ; ; Table used to decode input and invoke code when hit DELIMITER. ; 70$: .WORD '>, 100$ ; return data **** .WORD '<, 200$ ; return data, TRIMMED **** .WORD '>+200, 100$ ; return data .WORD '<+200, 200$ ; return data, TRIMMED .WORD ']+200, 300$ ; return data, RGHT JUSTIFIED .WORD '[+200, 400$ ; return data, LEFT JUSTIFIED .WORD '(+200, 500$ ; return data, LEFT JUSTIFIED, TRIMMED .WORD ')+200, 500$ ; return data, RGHT JUSTIFIED, TRIMMED .WORD '|+200, 600$ ; return data, CENTERED .WORD 'I+200, ..DIRI ; get field name from variable .WORD 00, 40$ ; no delimiter -> part of FIELD name ; ; ; ; Return contents of field without change. ; 100$: CALL 700$ ; load TMPBUF with data JMP 60$ ; all done ; ; ; Return contents after TRIMMING trailing blanks. ; 200$: CALL 201$ ; load trimed data JMP 60$ ; all done 201$: CALL 700$ ; load TMPBUF with data 220$: CMP R5,#TMPBUF ; at start of buffer BEQ 270$ ; yes -> skip CMPB -(R5),#40 ; have a trailing space? BNE 270$ ; no -> done CLRB (R5) ; place terminator BR 220$ ; loop 270$: RETURN ; all done ; ; ; Return contents after JUSTIFYing to the RIGHT. ; 300$: CALL 301$ ; load right justified data JMP 60$ ; all done 301$: CALL 700$ ; load data MOV R5,R4 ; R4 -> original eos CALL 220$ ; R5 -> last character in trimmed str INC R5 ; R5 -> eos NULL in trimmed string 330$: CMP R5,#TMPBUF ; at start of buffer? BEQ 340$ ; yes -> skip MOVB -(R5),-(R4) ; justify to right BR 330$ ; loop 340$: CMP R4,#TMPBUF ; at start of buffer? BEQ 370$ ; yes -> all done MOVB #40,-(R4) ; justify with spaces BR 340$ ; loop 370$: RETURN ; all done ; ; ; Return contents after JUSTIFYing to the LEFT. ; 400$: CALL 401$ ; load data left justified JMP 60$ ; all done 401$: CALL 700$ ; load TMPBUF MOV #TMPBUF,R0 ; R0 -> start of data MOV R0,R1 ; R1 -> start of buffer 410$: CMPB (R0)+,#40 ; have a leading space? BEQ 410$ ; yes -> loop DEC R0 ; R0 -> first non-space char 420$: CMP R0,R5 ; at EOS? BEQ 430$ ; yes -> skip MOVB (R0)+,(R1)+ ; shuffle chars left BR 420$ ; loop 430$: CMP R1,R5 ; at EOB? BEQ 470$ ; yes -> skip MOVB #40,(R1)+ ; pad buffer BR 430$ ; loop 470$: RETURN ; done ; ; ; ; Return LEFT JUSTIFIED and TRIMMED data ; 500$: CALL 401$ ; Load left justified data CALL 220$ ; trim data JMP 60$ ; all done ; ; ; Return CENTERED data ; 600$: CALL 401$ ; R5 -> eos for LEFT JUSTIFIED data MOV R5,R4 ; R4 -> original EOS CALL 220$ ; R5 -> last character in trimmed str MOV R4,R0 ; R0 -> original eos SUB R5,R0 ; R0 = difference in strings ASR R0 ; = amount padding needed ADD R5,R0 ; R0 -> where last char should go INC R5 ; R5 -> just after last character 640$: CMP R4,R0 ; correct number spaces @ end? BEQ 650$ ; yes -> skip MOVB #40,-(R4) ; no -> add one BR 640$ ; loop 650$: CMP R5,#TMPBUF ; any chars left to move right? BEQ 660$ ; no -> skip MOVB -(R5),-(R0) ; yes -> move it BR 650$ ; loop 660$: CMP R0,#TMPBUF ; need more spaces at front? BEQ 670$ ; no -> skip MOVB #40,-(R0) ; yes -> pad BR 660$ ; loop 670$: JMP 60$ ; all done ; ; ; ; This routine causes the desired data to be returned in .ASCIZ ; format in the TMPBUF buffer; if an invalid FIELD name is specified ; the invalid name is returned in TMPBUF. Note that R5 points to ; the string NULL terminator at exit. ; 700$: MOV $$FORM,R0 ; R0 -> FDT MOV #TMPBUF,R1 ; R1 -> field name string CALL LOCFLD ; attempt to locate field entry BCS 770$ ; failed -> return field name MOV R1,R5 ; R5 -> FDE MOV (R5),R0 ; R0 = field attributes MOV #TMPBUF,R1 ; R1 -> buffer MOV 4(R5),R2 ; R2 = offset in record to byte 1 ADD @$$FORM,R2 ; R2 -> first byte MOV 2(R5),R3 ; R3 = number bytes CALL ...DTA ; return field data MOV R1,R5 ; R5 -> EOS 770$: RETURN ; all done .SBTTL Actioning Routine - "..DIRI" ... switch input stream ; ; This routine is envoked to ensure that input comes from the stream whose ; identity code follows. Valid identify codes are ; ; ! for format file ; @ for user console ; A-Z for any one of 26 variables supported ; ; Use identity passed in R0 to pass control to approriate actioning code ; entry. ; ..DIRI: .INPUT ; R0 = stream ID CMPB R0,#'! ; input from format file? BEQ 1000$ ; yes -> skip CMPB R0,#'@ ; input from TTY? BEQ 1100$ ; yes -> skip SUB #'A,R0 ; R0 = variable index number CMP R0,#'Z-'A ; valid index? BLOS 2000$ ; yes -> process ABORT <..DIRI:invalid variable name!> ; ; To redirect input to format file simply point input vector to default input ; routine INPUT. To redirrect input to TTY must first get TTY input; this is ; stored in psuedo variable VAR.TT, after which we use 2000$ code to output ; what was entered just as if were handling a normal variable. ; 1000$: MOV #INPUT,INPVEC ; point default input routine RETURN ; all done 1100$: MOV #VAR.TT,R0 ; R0 -> TTY buffer variable CALL CON.LI ; get a line of input BR 2010$ ; can treat as any variable ; ; Further input to come from literal variable. Set up pointer needed to ; fetch bytes and redirrect input request to internal routine. ; 2000$: SWAB R0 ; R0 = offset to variable buffer ADD #VAR$$$,R0 ; R0 -> start variable buffer 2010$: DEC R0 ; preloop fudge.... MOV R0,VAR.FP ; set up fetch pointer CMP INPVEC,#2400$ ; input from variable already? BEQ 2060$ ; yes -> skip MOV INPVEC,2470$ ; save input stream pointer 2060$: MOV #2400$,INPVEC ; redirrect input requests 2070$: RETURN ; done 2400$: INC VAR.FP ; up pointer MOVB @VAR.FP,R0 ; fetch character BNE 2070$ ; not null -> return it MOV 2470$,INPVEC ; restore input vector JMP @INPVEC ; return a character 2470$: .WORD 0 ; points input stream ; .SBTTL Actioning Routine - "..DIRO" ... switch output streams ; ; This routine is envoked to redirrect output to the stream whose identity ; follows. Valid identify codes are ; ; ! for report file ; @ for user console ; A-Z for any one of 26 variables supported ; ; Use identity passed in R0 to pass control to approriate actioning code ; entry. ; ..DIRO: .INPUT ; R0 = stream ID CMPB R0,#'! ; send to report file? BEQ 1000$ ; yes -> skip CMPB R0,#'@ ; send to TTY? BEQ 1100$ ; yes -> skip SUB #'A,R0 ; R0 = variable index number CMP R0,#'Z-'A ; valid index? BLOS 2000$ ; yes -> process ABORT <..DIRO:invalid output stream!> ; ; Sending output to REPORT/TTY is easy, as we need only load the output vector ; with the address of the appropriate output routine. ; 1000$: MOV #OUTPUT,OUTVEC ; output to report file RETURN ; all done 1100$: MOV #CON.CO,OUTVEC ; output to console RETURN ; all ok ; ; Sending output to a variable requires that we calculate the address of ; the variables buffer and set up parameters needed for storing data in right ; place. We then load the output vector with the address of our internal ; routine that will store output in the variable. ; 2000$: SWAB R0 ; R0 = offset to variable buffer ADD #VAR$$$,R0 ; R0 -> variable data buffer MOV R0,VAR.SP ; set up store pointer CLR VAR.CT ; no characters stored as yet MOV #2400$,OUTVEC ; redirrect output RETURN ; done 2400$: CMP VAR.CT,#254. ; filled buffer? BHIS 2410$ ; yes -> abort MOVB R0,@VAR.SP ; save character INC VAR.SP ; up pointer CLRB @VAR.SP ; force into buffer INC VAR.CT ; one more byte in buffer RETURN ; all done 2410$: ABORT <..DIRO:too many characters for variable!> ; .SBTTL Primitive - "...DTA" ... ENCODE binary data ; ; This routine returns the .ASCIZ equivalent of a DBSMNG binary data item. ; Only R1 is changed; at exit it points to the string terminator. The ; register arguments are ; R0 data type (0-2=ASC 3=NUM 4=DAT) ; R1 buffer ; R2/R3 data address/size (size in bytes) ; ...DTA: .PUSH ; save BIC #^C7,R0 ; R0 = field type ASL R0 ; R0 = Index for field CALL @100$(R0) ; invoke appropriate routine CLRB (R1) ; terminate string .POP ; restore RETURN ; done 70$: ABORT <...DTA:unsupport data type!> 100$: .WORD 1000$,1000$,1000$,3000$,4000$,70$,70$,70$ ; ; Are here to return contents of an ascii field. ; 1000$: TST R3 ; size = 0? BEQ 1100$ ; yes -> done MOVB (R2)+,(R1)+ ; copy untill ... SOB R3,1000$ ; ... all bytes transfered 1100$: RETURN ; all done ; ; We are here to return the contents of a numeric field. ; 3000$: CALL 3700$ ; R2 = number CNAF SSSSD ; convert to ascii @R1 RETURN ; all done 3700$: MOVB (R2),R0 ; R0 = LOB data MOVB 1(R2),R2 ; R2 = HOB data BIC #^C377,R0 ; discard unwanted bits BIC #^C377,R2 ; discard unwanted bits SWAB R2 ; R2 = HOB data in correct byte ADD R0,R2 ; R2 = 16 bit data RETURN ; all done ; ; We are here to return the contents of a date field. ; 4000$: CALL 3700$ ; R2 = data to convert MOV R2,R3 ; R3 = DATE in RDM format BIC #^C31.,R2 ; R2 = days CNAF DD ; convert to ascii MOVB #'-,(R1)+ ; delimiter time MOV R3,R2 ; R2 = DATE ASH #-5,R2 ; move month into LOBs BIC #^C15.,R2 ; R2 = month CNAF DD ; convert to ascii MOVB #'-,(R1)+ ; delimiter time MOV R3,R2 ; R2 = DATE ASH #-11.,R2 ; move year into LOBs BIC #^C15.,R2 ; R2 = month ADD #72.,R2 ; change base from 1972 -> 1900 CNAF DD ; convert to ascii RETURN ; all done .SBTTL Primitive - "COMPAR" ... compare two variables ; ; ; This primitives sets the procesor falgs according to the results ; of a CMP V1,V2 instruction, where V1 and V2 are two internal ; variables, the names of which are next in the input stream. ; COMPAR: .INPUT ; get variable name CALL 500$ ; convert to address MOV R0,R1 ; save in R1 .INPUT ; get variable name CALL 500$ ; convert to address 100$: CMPB (R0)+,(R1)+ ; compare bytes BNE 200$ ; not same -> exit TSTB -1(R0) ; hit EOV? BNE 100$ ; no -> loop 200$: RETURN ; exit ; 500$: SUB #'A,R0 ; R0 = index number CMP R0,#'Z-'A ; valid index? BHI 600$ ; no -> abort SWAB R0 ; R0 = offset ADD #VAR$$$,R0 ; R0 -> variable RETURN ; exit 600$: ABORT ; .SBTTL Primitive - "OUTBUF" ... output buffer @R0 ; ; This routine is called to output the .ASCIZ string @R0. ; OUTBUF: .PUSH ; save MOV R0,R1 ; R1 -> data 100$: MOVB (R1)+,R0 ; R0 = char BEQ 200$ ; eos -> skip CALL @OUTVEC ; output BR 100$ ; loop 200$: .POP ; restore RETURN ; exit ; ; .SBTTL Primitive - 'DECODE' ... used to decode input ; ; Routine called with R1 pointing to table. Table consists ; of two word entries. Control passed to routine whose address ; is in secon word iff R0 matchs first word in entry. Table ; is terminated with an entry that has first word of 0. If cannot ; find matching entry in table, pass control to routine whose ; address is specified in terminating (null word 1) entry. ; DECODE: TST (R1) ; eot? BEQ 1200$ ; yes -> abort CMP R0,(R1) ; match? BEQ 1200$ ; yes -> skip ADD #4,R1 ; bump pointer BR DECODE ; loop ; 1200$: JMP @2(R1) ; pass over control ; .SBTTL Primitive - "IOVRST" ... reset I/O vectors ; ; This routine is called to reset the I/O vectors so that all input comes ; from the default input stream (ie the FORMAT file) and all output goes to ; the default output stream (ie the REPORT file). This is done by loading ; the INPUT and OUTPUT vectors with the addresses of internal routines. The ; internal input routine uses FRMINC to get the next character from the ; format file; it also checks for the EOF error condition. The output routine ; passes all characters to the report file, unless the F.NEWP flag is set, in ; which case only the and characters are passed, and support user ; defined RULERs (see ..RULE) by handling TABs specially. ; IOVRST: MOV #INPUT,INPVEC ; All input requests goto 1000$ MOV #OUTPUT,OUTVEC ; All output requests goto RPT file RETURN ; easy ; INPUT: CALL FRMINC ; get a character BCS 1100$ ; error -> abort RETURN ; exit, all ok 1100$: ABORT ; OUTPUT: CMPB R0,#15 ; ? BEQ 4700$ ; yes -> output always CMPB R0,#12 ; ? BEQ 4710$ ; yes -> output always INC CHRCNT ; one more character on line TST F.NEWP ; output allowed? BNE 4000$ ; no -> abort CMPB R0,#'I-'@ ; TAB? BNE 4710$ ; no -> output normally TST RULTAB ; RULER defined? BEQ 4710$ ; no -> output as a TAB ; 2000$: DEC CHRCNT ; don't count TAB .PUSH ; save MOV #RULTAB,R0 ; R0 -> first count 2100$: TST (R0) ; at EOT? BEQ 2700$ ; yes -> ignore TAB CMP CHRCNT,(R0)+ ; found right count? BHIS 2100$ ; no -> loop MOV -(R0),R1 ; R1 = next TAB position SUB CHRCNT,R1 ; R1 = amount to move MOV (R0),CHRCNT ; adjust character count MOVB #40,R0 ; R0 = space 2200$: CALL RPTOUC ; output number ... SOB R1,2200$ ; ... of needed spaces 2700$: .POP ; restore 4000$: RETURN ; all done 4700$: MOV #1,CHRCNT ; reset character count 4710$: JMP RPTOUC ; send character to report ; .SBTTL Primitive - "ABORT" ... abort program execution ; ; get here if program is to be aborted; at entry R1 holds address of ; .ASCIZ string that gives reason of abort. This string is printed along ; with data from format file to allow error point to be found. ; ; ABORT: .PRINT #7000$ ; header .PRINT R1 ; reason for abort .PRINT #7100$ ; trailer ; MOV #70.,R2 ; R2 = counter 1000$: CALL FRMINC ; input char BCS 1700$ ; abort if EOS .TTYOUT ; output character SOB R2,1000$ ; loop 1700$: .EXIT ; done ; .nlist bin 7000$: .ASCII <15><12>|REPORT-fatal-|<200> 7100$: .ASCIZ <15><12>| error in format file before:| .even .list bin ; .SBTTL NORMAL Variables and data structures ; ; ; .PSECT DATA ; Open data area ; ====== ==== ; $$FORM: .WORD FORM$$ ; points to TEMPLATE F.EPMF: .WORD 0 ; ..EF?? determines how mode is exitted F.NEWP: .WORD 0 ; ..EP?? set if want new page F.EOD: .WORD 0 ; ..NEXT set if all sort entries done F.REPT: .WORD 0 ; ..NEXT if <>0 act as NOP INPVEC: .WORD 0 ; holds address of input routine OUTVEC: .WORD 0 ; holds address of output routine CHRCNT: .WORD 0 ; number bytes output to current RPT line RULTAB: .WORD 0 ; Used by ..RULE and OUTPUT to ... .BLKW 32. ; ... hold position of tab points ENTNUM: .WORD 0 ; Entry number PAGNUM: .WORD 0 ; Page number DATEBF: .ASCIZ /DD-MM-YY/<0> ; DATE buffer VAR.FP: .WORD 0 ; fetch pointer (VARRD) VAR.SP: .WORD 0 ; store pointer (VARWRT) VAR.CT: .WORD 0 ; store counter (VARWRT) TMPBUF: .BLKW 100 ; temporary buffer VAR.TT: .BLKW 100 ; TTY I/O buffer .SBTTL INIT Routine - "VARINT" ... Initialize variables A-Z ; ; ; The following code is used to initialize the variables A-Z and the ; DATBUF buffer; the variables A-F are not modified, and left as NULL ; string, while G-Z are loaded with the ENTSIZ, NUMENT, N0-N9, D0-D4 ; and L0-L2 variables passed by SELECT in the header block of the ; SFL file. ; ; To preserve memory, this initialization code resides ; in a special PSECT that overlays the buffer space used ; by the VARIABLES; This routine resides within the buffer ; area of variable F. ; .PSECT INTOVL,RW,I,GBL,REL,OVR ; open special PSECT ; ====== ====== . = VAR$$$ + <<'F-'A>*256.> ; start of variable F .BLKW 1 ; first word reserved ; ; Setup variables with ENTSIZ and NUMENT ; VARINT: MOV #VAR$$G,R5 ; R5 -> first variable MOV #2.,R4 ; R4 = loop counter MOV #2,R3 ; R3 = data size in bytes MOV #SFLPAR,R2 ; R2 -> data MOV #3.,R0 ; R0 = type, .NUM. CALL 4000$ ; convert N0-N9 to ascii ; ; ; Setup variables with SELECT variables N0-N9 ; MOV #10.,R4 ; R4 = loop counter MOV #2,R3 ; R3 = data size in bytes MOV #SFLPAR+100,R2 ; R2 -> first SELECT NUMERIC variable MOV #3.,R0 ; R0 = type, .NUM. CALL 4000$ ; convert N0-N9 to ascii ; ; Setup variables with SELECT variables D0-D4 ; MOV #5.,R4 ; R4 = loop counter ;; MOV #2,R3 ; R3 = data size in bytes ;; MOV #SFLPAR+100+20.,R2 ; R2 -> first SELECT DATE variable MOV #4.,R0 ; R0 = type, .DAT. CALL 4000$ ; convert D0-D9 to ascii ; ; ; Setup variables with SELECT variables L0-L2 ; MOV #3.,R4 ; R4 = loop counter MOV #SFLPAR+100+40.,R2 ; R2 -> first SELECT LITERAL variable CLR R0 ; R0 = type, .ASC. 1300$: MOV R5,R1 ; R1 -> buffer MOV (R2)+,R3 ; R2 -> data ; R3 = data size BIC #^C127.,R3 ;; maximum size = 127 bytes CALL ...DTA ; data @R2 -> buffer @R1 ADD #128.-2,R2 ; R2 -> next datum ADD #256.,R5 ; R5 -> start next variable SOB R4,1300$ ; loop ; ; ; Setup system date in DATEBF ; .DATE ; R0 = date in RT-11 format BIC #^C37777,R0 ; strip unwanted bits CLR R1 ; R1 = 0 ASHC #-5,R0 ; R1 = year count ADD R1,R0 ; R0 = date in internal format MOV #2,R3 ; R3 = data size in bytes MOV #DATEBF,R2 ; R2 -> data MOV R0,(R2) ; setup date in DATEBF MOV R2,R1 ; R1 -> buffer MOV #4.,R0 ; R0 = type, .DAT. CALL ...DTA ; convert to ascii RETURN ; exit ; ; ; ; This routine is called to convert R4 2 byte items into ascii. ; 4000$: MOV R5,R1 ; R1 -> buffer CALL ...DTA ; return field data ADD #2,R2 ; R2 -> next datum ADD #256.,R5 ; R5 -> start next variable SOB R4,4000$ ; loop RETURN ; all done ; .SBTTL OVERLAYED DATA STRUCTURES ; ; The following data structures can be overlayed by the initialization ; code; be very careful if modifying the data structure. ; .PSECT INTOVL,RW,I,GBL,REL,OVR ; open special PSECT ; ====== ====== . = VAR$$$ ; position at start of section ; VAR$$A: .BYTE 0 ; Variable A .BLKB 255. ; initially (see VARINT) VAR$$B: .BYTE 0 ; Variable B .BLKB 255. ; initially VAR$$C: .BYTE 0 ; Variable C .BLKB 255. ; initially VAR$$D: .BYTE 0 ; Variable D .BLKB 255. ; initially VAR$$E: .BYTE 0 ; Variable E .BLKB 255. ; initially VAR$$F: .BYTE 0 ; Variable F .BLKB 255. ; initially VAR$$G: .BYTE 0 ; Variable G .BLKB 255. ; initially "ENTSIZ" VAR$$H: .BYTE 0 ; Variable H .BLKB 255. ; initially "NUMENT" VAR$$I: .BYTE 0 ; Variable I .BLKB 255. ; initially SELECT variable N0 VAR$$J: .BYTE 0 ; Variable J .BLKB 255. ; initially SELECT variable N1 VAR$$K: .BYTE 0 ; Variable K .BLKB 255. ; initially SELECT variable N2 VAR$$L: .BYTE 0 ; Variable L .BLKB 255. ; initially SELECT variable N3 VAR$$M: .BYTE 0 ; Variable M .BLKB 255. ; initially SELECT variable N4 VAR$$N: .BYTE 0 ; Variable N .BLKB 255. ; initially SELECT variable N5 VAR$$O: .BYTE 0 ; Variable O .BLKB 255. ; initially SELECT variable N6 VAR$$P: .BYTE 0 ; Variable P .BLKB 255. ; initially SELECT variable N7 VAR$$Q: .BYTE 0 ; Variable Q .BLKB 255. ; initially SELECT variable N8 VAR$$R: .BYTE 0 ; Variable R .BLKB 255. ; initially SELECT variable N9 VAR$$S: .BYTE 0 ; Variable S .BLKB 255. ; initially SELECT variable D0 VAR$$T: .BYTE 0 ; Variable T .BLKB 255. ; initially SELECT variable D1 VAR$$U: .BYTE 0 ; Variable U .BLKB 255. ; initially SELECT variable D2 VAR$$V: .BYTE 0 ; Variable V .BLKB 255. ; initially SELECT variable D3 VAR$$W: .BYTE 0 ; Variable W .BLKB 255. ; initially SELECT variable D4 VAR$$X: .BYTE 0 ; Variable X .BLKB 255. ; initially SELECT variable L0 VAR$$Y: .BYTE 0 ; Variable Y .BLKB 255. ; initially SELECT variable L1 VAR$$Z: .BYTE 0 ; Variable Z .BLKB 255. ; initially SELECT variable L2 ; ; ; .END START