TITLE 'APLOUT-B00,08/21/73,DWG702985' SYSTEM SIG7F SYSTEM BPM PAGE * REF'S: REF APLINPUT COMMON INPUT ROUTINE REF BITPOS BIT TABLE REF BLANKS X'40404040' REF BREAKFLG BREAK OR 'HANGUP' FLAG REF BREPROMT BRANCH TO REPROMPT. REF BRFUNDEF RESUME IN FUNDEF MODULE. REF BSPFLAG BACKSPACE VALIDITY FLAG REF CURRCS CURRENT CS BLOCK POINTER REF DIGITS REF DWSIZIM DW'S IN IMAGE REF ERRORCHR ERROR SIGNAL CHARACTER REF IMAGE APL 'IMAGE' I/O BUFFER REF INBUF APL INPUT-OUTPUT BUFFER REF INPDIR DIRECT INPUT DRIVER REF INPF FUNCTION EDIT INPUT DRIVER REF INPFAPND INPUT FUN.LINE APPEND. REF MAXCOL MAX COL POS FOR INPUT REF MERGECOL MERGE OR EDIT COLUMN # (FROM 1) REF MNEMT1 MNEMONIC TABLE 1-CHAR REF MNEMT2 MNEMONIC TABLE 2-CHAR REF MNEMT3 MNEMONIC TABLE 3-CHAR REF MODE MODE FLAG REF OFFSET CODESTRING ERROR BYTE OFFSET REF ON%OFF ONLINE-OFFLINE FLAG REF OUTMNEMT OUTPUT MNEMONIC-OVST FLAG TABLE REF OUTRANST OUTPUT TRANSLATION TABLE REF OUTMAXSZ OUTPUT RECORD BLOCK SIZE REF OUTSIZ SIZE OF OUTPUT RECORD(5) REF OVHWTABL OVERSTRIKE HW TABLE REF PRMTIMAG PROMPT WITH CURRENT IMAGE REF RDAPL READ A RECORD REF SYMT ADDRESS OF ADDRESS OF SYMBOL TABLE REF SYSTERR SYSTEM ERROR REF TABVALS TAB VALUES REF UNREF END DECODE OPS FOR ERROR DIAG. REF VISIMAGE BUFFER TO SAVE IMAGE DURING EDIT REF WIDTH REF WROUTWB WRITE OUTPUT-WORD BOUND REF WRTEXTC WRITE OUTPUT-TEXTC FORM REF X4E1 X'4E100000' REF X1FFFF ADDRESS MASK REF ZEROZERO * DEF'S: DEF APLOUT@ START OF PROCEDURE DEF APLOUT0 START OF CONTEXT DEF CHEKWID CHECK WIDTH DEF CINTIM CONVERT INTEGER INTO IMAGE DEF CREALBIN CONVERT REAL TO BINARY. DEF DECODOPS DECODESTRINGER DEF ENDIMAGE END OF IMAGE IN USE DEF DUMPLINE 13-00006 DEF DUMPLING LINE DUMP ROUTINE DEF DUMPLINP DUMP IMAGE-PROBABLY AS PROMPT DEF EDECODOP ERROR CALL TO: DECODOPS DEF EDUMPLIG DUMPLING DEF EDUMPLIN DUMPLINE DEF FFFFFFFE DEF FLHALF DEF FLONE DEF FLTEN DEF FUNLDISP FUNCTION LINE DISPLAY DEF FUNLDIS% DEF GENCHAR DEF GENDIGS GEN. EBCDIC DIGITS. DEF GENDIGSE GEN. E-FORMAT DEF GENEXP GEN. EXPONENT FORM. DEF GENNAME DEF GENNAME0 GENNAME ENTRY FOR NO INDENT ON VFL DEF GENTEXT TEXT GENERATOR ROUTINE DEF IDBUF ID RECORD BUFFER DEF IMAGEPOS IMAGE POSITION DEF IMAGES DEF MAXREAL MAX REAL # DEF MIXEDOUT COMPOUND STATEMENT OUTPUT DEF MTEMPIM2 MOVE TO IMAGE DEF NAMEBUF NAME PTR BUFFER DEF PLUSREAL DEF RANKARR ARRAY RANK DEF SAVESIX SAVE TEMP-USED BY )COPY-SHARED DEF SETCHAR STORES A CHAR. DEF SHOWFL DISPLAY-APPEND-OR EDIT-FUNCTION LN. DEF SHOWSTOP DEF SIDR SI DAMAGE WARNING REPORT DEF SINGOUT SINGLE DATA BLOCK OUTPUT DEF STASHBL STASH BLANK IN IMAGE DEF TABPNTR TAB INDICATOR DEF TABPNTR1 TAB POINTER TEMP DEF TENSTBL POWERS OF 10 (FIXED POINT) DEF TEXTC2I MOVE TEXTC MSG TO IMAGE. * STANDARD EQU'S: R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 BLANK EQU X'40' IDLE EQU X'16' * * CODESTRING PARAMETERS * CSBLOCK EQU 7 TYPE FOR CODESTRING DATA BLOCK CSEND EQU 139 OFFSET OF LAST CS VALUE FNOFF EQU 5 FUNCT NAME OFFSE1 PAGE * MODULE DESCRIPTION * * THIS MODULE INCLUDES THE OUTPUT ROUTINES AND PROCESSORS * FOR APL-EXCEPT WORKSPACE FILE OUTPUT AND THE FILE OUTPUT SYSTEM * INCLUDED ARE DIRECT AND QUAD OUTPUT,BLIND OUTPUT, AND * OUTPUT GENERATED AS A RESULT OF SOME COMMAND ACTIVITY * OUTPUT CONVERSION ROUTINTES AS WELL AS OUTPUT IMAGE FORMATTING * IS INCLUDED * PAGE APLOUT0 CSECT 0 * * VARIABLE PARAMETERS AND TEMPS * TABPNTR DATA 0 TAB VALUE FLAG TABPNTR1 RES 1 TEMP POINTER TO TABVALS * PROGRAM SWITCH IN DUMPLINE ROUTINE GBYTOTAB LB,R4 IMAGE,R3 (OR B CHEKTABS) * ENDIMAGE RES 1 END OF IMAGE POINTER CSERRBYT RES 1 CODESTRING ERROR BYTE BOUND 8 IMAGES DATA 0,0 NO. OF IMAGE LINES OUTPUT IMERRBYT EQU IMAGES+1 IMAGE ERROR BYTE POSITION IMAGEPOS RES 1 IMAGE POSITION LASTSCAN RES 1 SAVENDS RES 1 SAVE BYTES ENCLOSING CODESTRING CURRTAB RES 1 CURRENT TAB-TEMP OUTBUF RES 1 INBUF-OUTBUF SIZE POINTER BLCOUNT RES 1 BLANK COUNT-TEMP SAVE8 RES 1 TEMP * * SAVE AND TEMP AREA FOR SINGOUT AND MIXEDOUT * * * * CONVRTR-PROGRAM SWITCH FOR OUTPUT CONVERSION ROUTINES SINGOUT-MIXEDOUT * CONVRTR B INTARRAY (EXAMPLE) BOUND 8 @@@@@@@ HIREAL RES 2 @ DMAX EQU HIREAL @ EFLAG EQU HIREAL+1 @ LOREAL RES 2 @ DMINP5 EQU LOREAL @ BITCOUNT EQU LOREAL+1 @@@@@@@ BOUND 8 IDBUF RES 16 STORAGE FOR WS OR FIO ID RECORD SAVE114 EQU IDBUF REG SAVE FOR MIXEDOUT-SINGOUT ROWSIZE EQU IDBUF+14 ROW LENGTH-OUTPUT ROUTINES RANKARR EQU IDBUF+15 RANK OF ARRAY-OUTPUT ROUTINES BOUND 8 NAMETEMP RES 64 BUFFER TO BUILD OUTPUT NAMES NAMEBUF EQU NAMETEMP NAME POINTER BUFFER BLOCKNUM RES 1 NUMBER OF DATA BLOCKS TO OUTPUT DBASE RES 1 DATA BASE-OUTPUT ROUTINES DSIZE RES 1 DATA SIZE-OUTPUT ROUTINES EVALUE RES 1 EXPONENT VALUE-TEMP LBASEM1 RES 1 BASE-1 OF LENGTH WORDS FOR ARRAY PTRPTR RES 1 DATA POINTER-POINTER SAVESIX EQU BLOCKNUM BLOCKNUM TO PTRPTR-SHARED WITH * SAVESIX. SAVESIX IS USED BY * WRACTIV IN MODULE APLUTSC,DURING * EXECUTION OF )COPY SAVE212 RES 11 SAVE R2-R12 -BY-DUMPLINE PAGE APLOUT@ CSECT 1 * BOUND 8 * PRANGE-TABLE OF FLOATING POINT-LONG VALUES:1E0 TO 1E16 * DATA,8 FL'1E-1' ** PRANGE-2 PRANGE DATA,8 FL'1E0',FL'1E1',FL'1E2',FL'1E3',FL'1E4',FL'1E5' DATA,8 FL'1E6',FL'1E7',FL'1E8',FL'1E9',FL'1E10',FL'1E11' DATA,8 FL'1E12',FL'1E13',FL'1E14',FL'1E15',FL'1E16' FLONE EQU PRANGE FLTEN EQU PRANGE+2 FLHALF DATA,8 FL'0.5' FLTENS DATA,8 FL'10',FL'10000',FL'10000000000000' MAXREAL DATA X'7FFFFFFF',X'FFFFFFFF' MAX FL # POWERS DATA 1,4,13 * * TENSTBL-TABLE OF POWERS OF 10 AS INTEGERS * TENSTBL DATA 1,10,100,1000,10000,100000,1000000 DATA 10000000,100000000,1000000000 * FFFFFFFE DATA X'FFFFFFFE' MASK * PAGE * * DUMPLINE-ROUTINE TO DUMP A LINE FROM 'IMAGE' VIA F:OUT * * ENTRIES:DUMPLINE-NOT A PROMPT-LINE FOLLOWED BY CR * DUMPLINP-LINE IS FUNCTION EDIT PROMPT-ENDS WITH 'IDLE' * * IF ENTRY IS FROM DUMPLINE,R3 IS THE BYTE OFFSET TO * 1 CHARACTER PAST END OF IMAGE. ENDIMAGE OFFSET IS * SAVED AND R3 IS SET TO 'BLANKS'. ON EXIT, R3 IS SET * TO 6 AND THE FIRST 8 BYTES OF IMAGE ARE BLANKED * * IF ENTRY IS FROM DUMPLINP,THE LAST CHARACTER IS AN IDLE, * INDICATING NO CR(TO COC HANDLER). ENDIMAGE IS SAVED, * AND R3 IS SET 0. ON EXIT, IMAGE IS INTACT * * IMERRBYT IS TESTED AND,IF SET (>0) THE IMAGE OUTPUT IS * FOLLOWED BY AN ERROR POINTER * * R12 IS LINK * * REGISTERS R2 TO R12 ARE SAVED AND RESTORED PRIOR TO EXIT * * INTERNALLY:R3 IS POINTER IN IMAGE * R6 IS POINTER IN INBUF(OUTPUT BUFFER) * * CALWROUT IS CALLED FOR ACTUAL OUTPUT OF LINE * SEGMENTS:LINK R7,REGISTERS USED,R8,R9,R10 * * OUTPUT LINE SEGMENTS ARE BUILT SEQUENTIALLY IN 'INBUF' AND * LEFT IN PLACE FOR POSSIBLE SUBSEQUENT USE * LOCAL LCI,TABN,TABLESS,GETIMBYT,NOTABS,CHEKTABS,BUMPTAB LOCAL CHKBLNK,SETTAB,VARTABS,NOTYET,OUTBLNKS,BLOOP,UPBLCT LOCAL USCL,SINGLOUT,BSOVST,NEXTMOVE,FORWARD,BSSET,BLANKIT LOCAL LASTSEG,NOMOROUT,PUSHOUT1,PUSHOUT2 LOCAL CARETSET EDUMPLIG EQU DUMPLING ERROR CALL TO DUMPLING. DUMPLING CI,R3 0 CHECK FOR NULL LINE BLE *R12 YES-EXIT AI,R3 -1 ADJUST POINTER DUMPLINP STW,R3 ENDIMAGE SAVE END OF IMAGE LI,R3 0 SET R3=0-FLAG FOR EXIT B LCI EDUMPLIN EQU DUMPLINE ERROR CALL TO DUMPLINE. DUMPLINE AI,R3 -1 ADJUST IMAGE POINTER STW,R3 ENDIMAGE SAVE IT LW,R3 BLANKS SET R3= BLANKS-USED IN EXIT LCI LCI 11 STM,R2 SAVE212 MTW,1 IMAGES KICK IMAGE COUNT LW,R3 ENDIMAGE RESTORE R3 IMAGE END BLEZ CKIMERR IF ZERO,SKIP NEXT ITEM LB,R2 IMAGE,R3 CHECK FOR AND DELETE CI,R2 X'40' TRAILING BLANKS BNE %+2 BDR,R3 %-3 STW,R3 ENDIMAGE SET NEW END OF IMAGE CKIMERR LCW,R6 IMERRBYT CHECK IF IMAGE IS ERROR FLAGGED BGEZ FORWARD NO MTW,0 BSPFLAG CHECK FOR BS CAPABILITY ON TERMINAL BEZ FORWARD NO CI,R3 MAXCOL CHECK FOR WIDE IMAGE BG FORWARD YES SW,R3 IMERRBYT GET DISTANCE FROM HI-END CW,R3 IMERRBYT COMPARE WITH DISTANCE FROM LOW END BGE FORWARD AI,R3 1 LI,R5 8 BS LW,R4 ENDIMAGE BSSET AI,R4 1 STB,R5 IMAGE,R4 LOOP-BS'S BDR,R3 BSSET LI,R5 X'20' IX AI,R4 1 STB,R5 IMAGE,R4 LB,R5 ERRORCHR ERROR CARET-TERMINAL DEPENDANT AI,R4 1 CARETSET STB,R5 IMAGE,R4 STW,R6 IMERRBYT SET IMERRBYT NEGATIVE STW,R4 ENDIMAGE RESET ENDIMAGE FORWARD LW,R6 NOTABSET SET SWITCH TO SKIP TAB CHECKS LW,R3 TABPNTR CHECK FOR TAB SETS BEZ TABLESS NO LW,R6 TABSET SET SWITCH TO USE TAB CHECKS CI,R3 128 YES-CHECK EQUIDISTANT VS INDIVIDUAL BL TABN EQUIDISTANT LI,R3 1 INDIVIDUAL STW,R3 TABPNTR1 GET FIRST SET LB,R3 TABVALS,R3 TABN STW,R3 CURRTAB SET CURRENT TAB MTW,-1 CURRTAB DECREMENT (FOR 0 INDEXING) TABLESS LI,R3 0 SET IMAGE POSITION AT START STW,R6 GBYTOTAB PROGRAM SWITCH (TABS OR NOTABS) LI,R4 INBUF STW,R4 OUTBUF SET START OF OUTBUF=INBUF LI,R6 0 SET INBUF POSITION AT START STW,R6 BLCOUNT ZERO BLANK COUNT LW,R12 OUTMAXSZ AI,R12 -1 SET LOOP FOR LINE SEGMENT OUTPUT GETIMBYT EXU GBYTOTAB LB,R4 IMAGE,R3 OR B CHEKTABS NOTABS LB,R5 OUTRANST,R4 GET OUTPUT CHAR OR OFFSET LB,R7 OUTMNEMT,R4 GET TYPE FLAG BEZ SINGLOUT SINGLE CHARACTER CI,R7 4 CHECK TYPE FLAG BE BSOVST OVERSTRIKE-GENERAL BG USCL UNDERSCORED LETTER AW,R5 MNEMTN-1,R7 ** THIS POINT SHOULD BE REACHED ONLY LW,R2 R5 ** FROM LINE-SCAN ERROR-WIDTH SETTING LW,R4 R7 ** MAY BE EXCEEDED. LI,R5 X'5B' TRUE (NOT APL.) % BAL,R11 PUSHOUT1 OUTPUT IT LI,R11 %+1 SET LOOP LB,R5 0,R2 GET MNEMONIC CHARACTER AI,R2 1 BDR,R4 PUSHOUT1 OUTPUT MNEMONIC CHARACTERS B SINGLOUT CHEKTABS LB,R4 IMAGE,R3 GET CHARACTER CW,R3 CURRTAB CHECK IF TAB SET REACHED BL NOTYET NO LW,R5 TABPNTR CHECK TYPE OF TAB OPTION CI,R5 128 BGE VARTABS INDIVIDUAL SETS BUMPTAB AWM,R5 CURRTAB VECTOR-KICK BY INTERVAL CHKBLNK CI,R4 BLANK BNEZ OUTBLNKS NOT BLANK-DUMP ANY PENDING LI,R5 0 XW,R5 BLCOUNT RESET BLANK COUNT BEZ NOTABS IF IT WAS 0, OUTPUT BLANK SETTAB LI,R4 5 SET TAB CHAR (INTERNAL) IN R4 B NOTABS GENERATE IT VARTABS MTW,1 TABPNTR1 POINT TO NEXT TAB LW,R7 TABPNTR1 LB,R7 TABVALS,R7 GET NEXT TAB BEZ BUMPTAB TOO FAR-SET TO ACCUMULATE BLANKS AI,R7 -1 OFFSET STW,R7 CURRTAB SET NEW CURRTAB B CHKBLNK NOTYET CI,R4 BLANK BE UPBLCT OUTBLNKS LW,R2 BLCOUNT CHECK FOR PENDING BLANKS BEZ NOTABS NONE LI,R5 BLANK SOME-SET BLANK BLOOP BAL,R11 PUSHOUT1 OUTPUT BLANK BDR,R2 BLOOP LOOP UNITL BLCOUNT=0 STW,R2 BLCOUNT REJET BLANK COUNT B NOTABS GET OUTPUT CHAR UPBLCT MTW,1 BLCOUNT KICK BLANK COUNT B NEXTMOVE * USCL BAL,R11 PUSHOUT1 LETTER LI,R5 8 BACKSPACE BAL,R11 PUSHOUT1 LI,R5 X'6D' UNDERSCORE LB,R5 OUTRANST,R5 TRANSLATE IT SINGLOUT LI,R11 NEXTMOVE B PUSHOUT1 * BSOVST LH,R8 OVHWTABL,R5 GET FIRST & SECOND CHARACTER IN R8 STW,R8 SAVE8 SAVE LI,R5 2 SET INDEX LB,R5 R8,R5 GET FIRST CHAR IN R5 LB,R5 OUTRANST,R5 TRANSLATE SINGLE CHARACTER BAL,R11 PUSHOUT1 PUSH IT LI,R5 8 BS BAL,R11 PUSHOUT1 LI,R5 X'FF' BYTE MASK AND,R5 SAVE8 GET 2ND BYTE LB,R5 OUTRANST,R5 AND TRANSLATE IT B SINGLOUT * NEXTMOVE AI,R3 1 CW,R3 ENDIMAGE CHECK IF IMAGE PROCESS COMPLETE BLE GETIMBYT NO MTW,0 BLCOUNT CHECK FOR TRAILING BLANKS 13-00001 BEZ LASTSEG NO 13-00002 LI,R5 BLANK YES-INSERT 1 BLANK 13-00003 BAL,R11 PUSHOUT1 13-00004 LASTSEG SW,R12 OUTMAXSZ YES AI,R12 1 CHECK IF OUTPUT REMAINS BEZ NOMOROUT NO LCW,R9 R12 YES-SIZE IN BYTES BAL,R11 PUSHOUT2 GENERATE RECORD LW,R4 IMERRBYT CHECK IF ERROR LINE FOLLOWS BLEZ NOMOROUT NO LW,R5 BLANKS YES-BLANK IMAGE LI,R7 DWSIZIM BLANKIT STD,R5 IMAGE-2,R7 BDR,R7 BLANKIT LB,R5 ERRORCHR GET ERROR CARET LI,R6 -1 FLAG -NEGATIVE- FOR IMERRBYT B CARETSET NOMOROUT STW,R6 OUTSIZ SET OUTSIZ-IN CASE OUTPUT IS PROMPT LCI 11 LM,R2 SAVE212 RESTORE REGISTERS AI,R3 0 CHECK TYPE OF ENTRY BEZ *R12 DUMPLINP-LEAVE IMAGE INTACT STD,R3 IMAGE SET BYTES 0-7 OF IMAGE BLANK LI,R3 6 SET R3=6 B *R12 EXIT * PUSHOUT1 STB,R5 INBUF,R6 STASH BYTE FOR OUTPUT AI,R6 1 BDR,R12 *R11 COUNT DOWN CW,R3 ENDIMAGE CHECK COINCIDENT END OF IMAGE BE LASTSEG YES-OUTPUT LAST LINE SEGMENT LI,R12 IDLE NO-SET IDLE IN LINE STB,R12 INBUF,R6 THIS SIGNALS -NO CR- AI,R6 1 LW,R9 OUTMAXSZ MAX OUTPUT SIZE IN BYTES PUSHOUT2 LW,R8 OUTBUF OUTPUT BUFFER ADDRESS BAL,R7 WROUTWB OUTPUT A LINE SEGMENT (OR LINE) SLS,R9 -2 SIZE IN WORDS AWM,R9 OUTBUF SET NEW OUTBUF START LW,R12 OUTMAXSZ RESET COUNTDOWN BDR,R12 *R11 DECREMENT (FOR IDLE) AND RETURN * PROGRAM SWITCHES NOTABSET LB,R4 IMAGE,R3 GET BYTE FROM IMAGE TABSET B CHEKTABS CHECK TABS PAGE * * STASH ROUTINES * R11 IS LINK * R3 UPDATED R8 USED * R12 USED IF DUMPLINE CALLED * DUMPLINE SAVES & RESTORES REGS. EXCEPT R3-UPDATED * QSTASHBL LI,R8 1 CHECK OLD LASTSCAN-SET NEW XW,R8 LASTSCAN LASTSCAN NON-ZERO BEZ *R11 EXIT IF OLD LASTSCAN=0 CW,R3 IMERRBYT CHECK IF THIS IS ERROR POINT BNE STASHBL NO MTW,1 IMERRBYT YES-KICK POINTER PAST BLANK STASHBL LI,R8 BLANK SET BLANK STASHIM CW,R3 WIDTH CHECK WIDTH OVERFLOW BL SETR8 NO BAL,R12 DUMPLINE YES-DUMP LINE FIRST SETR8 STB,R8 IMAGE,R3 STASH BYTE AI,R3 1 UPDATE POSITION B *R11 EXIT PAGE * * CHECKWID-CHECK IF WIDTH PERMITS PRINTING MULTI-CHARACTER FIELD * IF NOT,DUMP LINE-R7 IS NOT RESTORED * CHEKWID AW,R7 R3 ADD POSITION TO FIELD WIDTH-1 CW,R7 WIDTH BL *R11 OK BAL,R12 DUMPLINE NO-DUMP LINE B *R11 PAGE * * GENMNEM-GENERATE OUTPUT MNEMONIC IN IMAGE * * * ON ENTRY TO GENMNEM: * R3 POINTS TO IMAGE BYTE FOR STASHING OUTPUT * R4 CONTAINS THE INTERNAL APL CHARACTER TO BE REPLACED BY MNEM. * R5 IS LINK * R6 POINTS TO SOURCE-CODESTRING OR TEXT * R7 CONTAINS MNEMONIC TYPE 1CHAR,2CHAR OR 3CHAR. * * GENMNEM USES: * R2,R5,R7,R8,R11,R12 CHANGED * R3-UPDATED * R4-UNCHANGED * * GENMNEM CALLS: * CHECKWID (WHICH USES R3,R7,R11,R12) * SETR8 (WHICH USES R3,R8,R11) * DUMPLINE (WHICH USES R12-SAVES & RESTORES OTHER REGISTERS * CHANGES R3) * LOCAL LOOP% GENMNEM BAL,R11 CHEKWID CHECK IF MNEMONIC WILL FIT LB,R7 OUTMNEMT,R4 RESTORE MNEMONIC TYPE IN R7 LB,R2 OUTRANST,R4 GET TABLE OFFSET AW,R2 MNEMTN-1,R7 GET ADDRESS OF MNEMONIC LI,R8 X'43' % BAL,R11 SETR8 STASH IT AI,R7 1 LI,R11 LOOP% SET LOOP LOOP% LB,R8 0,R2 GET MNEMONIC BYTE(S) AI,R2 1 BDR,R7 SETR8 STASH B 0,R5 RETURN * * MNEMTN-BYTE ADDRESSES OF MNEMONIC TABLES * MNEMTN DATA BA(MNEMT1) DATA BA(MNEMT2) DATA BA(MNEMT3) PAGE * * GENTEXT-ROUTINE TO GENERATE TEXT IN IMAGE BUFFER * MNEMONICS ARE EXPANDED,OVERSTRIKES ARE NOT * IF ENTRY FROM CODESTRING TEXT, QUOTES ARE DOUBLED * * R13=LINK * R10=BYTE COUNT-DECREMENTED TO 0 * R6 POINTS TO FIRST SOURCE BYTE-1 ON ENTRY * POINTS TO LAST SOURCE BYTE ON EXIT * R3 POINTS TO IMAGE BYTE OFFSET ON ENTRY * POINTS TO NEXT IMAGE BYTE OFFSET ON EXIT * R4,R5,R7,R8 USED INTERNALLY * * ROUTINES CALLED: * STASHIM (USES R3,R8,R11,R12) * DUMPLINE(USES R12-USES&SAVES OTHER REGISTERS-CHANGES * R3) * GENMNEM (USES R2,3,4,5,7,8,AND 11) * LOCAL GENTEXT2,SETR4,GENTEXT3,GENTEXT4 LOCAL LOOP GENTEXT1 LI,R10 1 SET LOOP SIZE 1 B GENTEXTC BYPASS SET-UP OF R4 GENTEXT AI,R10 0 CHECK FOR EMPTY TEXT BEZ *R13 YES-QUICK EXIT LOOP AI,R6 1 POINT TO SOURCE BYTE GENTEXTM LB,R4 0,R6 GET BYTE GENTEXTC LB,R7 OUTMNEMT,R4 CHECK FOR MNEMONIC BEZ SETR4 NO CI,R7 4 MAYBE BGE SETR4 NO-(DON'T EXPAND OVERSTRIKES) BAL,R5 GENMNEM YES-GENERATE MNEMONIC GENTEXT2 BDR,R10 LOOP B *R13 EXIT SETR4 CI,R4 X'15' CHECK FOR EMBEDDED CR BE GENTEXT3 YES CI,R13 CSGNTEXT+1 CHECK IF CALLED FROM CS-TEXT BNE GENTEXT4 NO-QUOTES NOT DOUBLED CI,R4 X'7D' YES-CHECK FOR QUOTE BNE GENTEXT4 NO LI,R8 X'7D' YES-DOUBLE IT BAL,R11 STASHIM STASH IT GENTEXT4 LW,R8 R4 SET R8 FOR STASH LI,R11 GENTEXT2 SET RETURN B STASHIM SET BYTE GENTEXT3 LI,R12 GENTEXT2 SET RETURN AI,R3 0 CHECK IF CR AT START OF LINE BGZ DUMPLING NO LI,R4 X'40' YES STB,R4 IMAGE GEN BLANK LI,R3 1 B DUMPLING PAGE * * CINTIM -CONVERT INTEGER TO EBCDIC AND PUT IN IMAGE * * ON ENTRY:R3 IS OFFSET POINTER TO IMAGE * R6 POINTS TO NEXT SOURCE BYTE-DO NOT CHANGE * R10 IS EXTERNAL LOOP COUNTER-DO NOT CHANGE * R13 IS LINK * R2,R3,R7,R8,R9,R11,R12 USED AND CHANGED * * ON EXIT, R3 POINT TO NEW OFFSET IN IMAGE * * 'CHEKWID' IS USED TO CHECK FOR WIDTH OVERFLOW-IF SO, * IMAGE IS DUMPED BEFORE MOVE IF WIDTH EXCEEDED. * * CINTIM IS USED FOR INTEGER SCALARS AND VECTORS-ARRAYS ARE * TREATED SEPARATELY * LOCAL CHEKSIZ,SIZFOUND,POSINT CINTIM LAW,R9 R8 GET ABS VALUE IN R9 LI,R2 9 NO-CHECK SIZE CHEKSIZ CW,R9 TENSTBL,R2 BGE SIZFOUND BDR,R2 CHEKSIZ SIZFOUND AI,R2 1 ADJUST COUNT LW,R7 R2 USE SIZE TO CHECK FOR IMAGE FIT AI,R8 0 BGEZ POSINT NON-NEG NUMB AI,R7 1 NEG NUMB-KICK SIZE FOR SIGN BIT POSINT BAL,R11 CHEKWID AI,R8 0 CHECK SIGN AGAIN BGEZ DIVLOOP POSITIVE LI,R8 X'72' NEGATIVE-SET SIGN BAL,R11 SETR8 DIVLOOP LI,R8 0 DW,R8 TENSTBL-1,R2 DIVIDE VALUE BY POWER OF 10 XW,R8 R9 R8=DIGIT, R9=REMAINING VALUE ZERINT AI,R8 X'F0' CONVERT TO EBCDIC BAL,R11 SETR8 STASH VALUE IN IMAGE BDR,R2 DIVLOOP LOOP B *R13 EXIT* * PAGE * * CINTARR-CONVERT INTEGER FOR ARRAY OUTPUT * FIXED FIELD WIDTH=DMAS+2 * NUMBER IS RIGHT JUSTIFIED IN FIELD * * R13=LINK * R10 IS EXTERNAL LOOP COUNTER-DO NOT CHANGE * R3 IS IMAGE OFFSET AND IS CHANGED * R2,R7,R8,R9,R11,R12 USED AND CHANGED * LOCAL CHEKSIZ,SIZFOUND CINTARR LW,R7 DMAX GET AI,R7 2 FIELD WIDTH BAL,R11 CHEKWID AND CHECK IMAGE OVERFLOW LAW,R9 R8 GET +VALUE LW,R7 R8 SAVE VALUE FOR SIEN & 0 TESTS LW,R2 DMAX SET LOOP SIZE CHEKSIZ CW,R9 TENSTBL-1,R2 CHECK SIZE OF VALUE BGE SIZFOUND BAL,R11 SETR8BL SET BLANK BDR,R2 CHEKSIZ LOOP SIZFOUND BAL,R11 SETR8BL SET 1 MORE BLANK LI,R11 DIVLOOP LW,R8 R7 CHECK VALUE BGZ SETR8BL +,SET 1 MORE BLANK BEZ ZERINT 0, SHORTCUT LI,R8 X'72' APL - B SETR8 SETR8BL LI,R8 X'40' SET BLANK B SETR8 PAGE * * CREALBIN-CONVERTS FL-LONG VALUE IN R8-R9 TO INTEGER IN R8-R9 * WITH-DECIMAL POSITION IN R12 * R12=0 INDICATES .XXX * R12>0 INDICATES NO.DIGITS LEFT OF DECIMAL * R12<0 INDICATES NO.ZEROS BETWEEN DECIMAL AND FIRST DIGIT * * R11 IS LINK * R7=X'72' (APL-SIGN) IF R8-R9 NEGATIVE,BLANK IF NOT * R2 USED INTERNALLY * R5 USED INTERNALLY * LOCAL SCALER,ROUNDER,FIXIT,ZEROREAL,DOWNSCL,UPSCALE CREALBIN LW,R5 DIGITS PRECISION SETTING LI,R7 BLANK SIGN FLAG-OFF AI,R8 0 CHECK SIGN AND VALUE BEZ ZEROREAL 0 BGZ PLUSREAL + LI,R7 X'72' - LCD,R8 R8 USE POSITIVE VALUE PLUSREAL LW,R12 R5 GET SIGNIFICANCE LI,R2 3 SET SCALER LOOP SCALER CD,R8 PRANGE,R5 CHECK HIGH END BGE DOWNSCL TOO HIGH CD,R8 PRANGE-2,R5 CHECK LOW END BL UPSCALE TOO LOW ROUNDER FAL,R8 FLHALF ROUND OFF CD,R8 PRANGE,R5 CHECK OVERFLOW OF RANGE BL FIXIT NO AI,R12 1 YES- LD,R8 PRANGE-2,R5 ADJUST FIXIT FAL,R8 X4E1 CONVERT TO BINARY INTEGER SW,R8 X4E1 B *R11 EXIT ZEROREAL LI,R9 0 ASSURE TRUE 0 LI,R12 1 SET DECIMAL POS B *R11 EXIT DOWNSCL FDL,R8 FLTENS-2,R2 DIVIDE BY POWER OF 10 AW,R12 POWERS-1,R2 ADJUST DECIMAL POSITION CD,R8 PRANGE,R5 CHECK BGE DOWNSCL -MORE- BDR,R2 SCALER CHECK AGAIN B ROUNDER FALL-THROUGH-SHOULDN'T BE REACHED UPSCALE FML,R8 FLTENS-2,R2 MULTIPLY BY POWER OF 10 SW,R12 POWERS-1,R2 ADJUST DECIMAL POSITION CD,R8 PRANGE-2,R5 CHECK BL UPSCALE NEEDS MORE BDR,R2 SCALER (SHOULD ALWAYS BRANCH) B ROUNDER FALL-THROUGH-SHOULDN'T BE REACHED PAGE * * GENDIGS-ROUTINE TO GENERATE EBCDIC DIGITS * FROM BINARY VALUE IN R8-R9 * DECIMAL INDICATOR IN R12 * * * GENDIGSE-ENTRY POINT FOR E FORMAT * R4=LINK * R2,R5,R7,R11 USED INTERNALLY * * NO LEADING OR TRAILING BLANKS GENERATED * NO TRAILING ZEROS RIGHT OF DECIMAL POINT * LOCAL ZLOOP,CDIGITS,DIVID,DIVIDS,NONZERO,NODOT LOCAL ZEROPUT,ZLOOP2 GENDIGSE AI,R12 -1 STW,R12 EVALUE SAVE 'E' VALUE LI,R12 1 SET TO GEN FORM X.XX--- GENDIGS AI,R12 0 CHECK DECIMAL INDICATOR BGZ CDIGITS BAL,R11 SETZER 0 LI,R7 X'4B' . BAL,R11 SETCHAR AI,R12 0 CHECK AGAIN BEZ CDIGITS NO LEADING ZEROS LI,R11 ZLOOP AI,R12 -1 ADJUST COUNT ZLOOP BIR,R12 SETZER OUTPUT ZEROS AS REQUIRED CDIGITS LI,R7 0 SET SHORT FORM (LOW HALF=0) LW,R2 DIGITS CHECK DIGITS CI,R2 10 BLE DIVIDS OK DIVIDE R8-R9 BY PWR OF 10 DW,R8 TENSTBL+9 DAMN: EXTENDED FORM LW,R7 R8 SAVE LOW HALF OF VALUE AI,R2 -9 ADJUST 'DIGITS' DIVID LI,R8 0 CLEAR R8 DIVIDS DW,R8 TENSTBL-1,R2 DIVIDE BY POWER OF 10 XW,R8 R9 SHIFT DIGIT TO R8-REST TO R9 AI,R8 X'F0' FORM EBCDIC VALUE STB,R8 0,R5 STASH IT AI,R5 1 AI,R9 0 CHECK FOR 0 REMAINDER BNEZ NONZERO NO AI,R7 0 MAYBE-CHECK LOW HALK BEZ ZEROPUT YES NONZERO AI,R12 -1 NO-CHECK FOR DECIMAL POSITION BNEZ NODOT NO LI,R8 X'4B' YES STB,R8 0,R5 AI,R5 1 NODOT BDR,R2 DIVID LOOP ON 'DIGITS' XW,R9 R7 DONE-CHECK FOR EXTENDED FORM BEZ 0,R4 NO LI,R2 9 DIGITS GR THAN 10-TWO PHASES OF B DIVID DIVISION ZEROPUT LI,R11 ZLOOP2 ZLOOP2 BDR,R12 SETZER B 0,R4 SETZER LI,R7 X'F0' SETCHAR STB,R7 0,R5 AI,R5 1 B *R11 PAGE * * GENEXP-GENERATE EX EXX E-X OR E-XX * R4=LINK R7,R8,R9,R11,R5 USED * LOCAL POSEXP,ONECHAR GENEXP LI,R7 'E' GENERATE 'E' BAL,R11 SETCHAR LW,R9 EVALUE GET EXP. VALUE BGEZ POSEXP LI,R7 X'72' SET - IF NEGATIVE BAL,R11 SETCHAR LAW,R9 EVALUE POSEXP LI,R8 0 DW,R8 TENSTBL+1 SEPARATE EVALUE INTO 10'S AND 1'S BEZ ONECHAR NO 10'S LW,R7 R9 AI,R7 X'F0' SET 10'S DIGIT BAL,R11 SETCHAR ONECHAR LW,R7 R8 LW,R11 R4 AI,R7 X'F0' SET 1'S DIGIT B SETCHAR AND EXIT PAGE * * CREALIM-CONVERT REAL VALUE IN R8-R9 TO PRINT FORMAT AND * PLACE IN IMAGE BUFFER * * THIS ROUTINE IS FOR CONVERSION OF SCALARS OR ELEMENTS * OF VECTORS-LEADING OR TRAILING BLANKS ARE **NOT** GENERATED * (BECAUSE OF USE IN CODESTRING OUTPUT) * * R13=LINK * * REGISTERS R1,R2,R4,R5,R7,R11,R12 USED INTERNALLY * REGISTER 3 USED AND UPDATED(IMAGE POINTER) * * ROUTINES USED: CREALBIN-CONVERT TO INTERMEDIATE FORM * GENDIGS -GENERATE DIGITS AND DEC. PT. * MTEMPIM -MOVE CHARACTERS FROM TEMP TO IMAGE * * THE RESULT IS FORMED IN A TEMP AREA BECAUSE LENGTH IS NOT * DETERMINATE PRIOR TO CONVERSION-WIDTH CHECK IS MADE BY MTEMPIM * PRIOR TO MOVE TO IMAGE * LOCAL NOTNEG,EFORM,MOVEIM CREALIM BAL,R11 CREALBIN CONVERT TO INTEGER & DEC POS LI,R5 BA(NAMETEMP) CI,R7 X'72' NEG SIGN CHECK BNE NOTNEG BAL,R11 SETCHAR SET - NOTNEG CI,R12 -4 CHECK OUTPUT FORM BLE EFORM E FORM-TOO LOW CW,R12 DIGITS BG EFORM E FORM-TOO HIGH BAL,R4 GENDIGS ORDINARY FORM-GENERATE DIGITS MOVEIM AI,R5 -BA(NAMETEMP) GET LENGTH LW,R1 R5 MTEMPIM LW,R7 R1 BAL,R11 CHEKWID CHECK IF NAME FITS ON IMAGE MTEMPIM2 LI,R8 BA(NAMETEMP) SET SOURCE ADDRESS FOR MBS LI,R9 BA(IMAGE) AW,R9 R3 SET TARGET ADDRESS FOR MBS STB,R1 R9 SET COUNT FOR MBS MBS,R8 0 AW,R3 R1 B *R13 EFORM BAL,R4 GENDIGSE E FORM GENERATE X.XXX--- BAL,R4 GENEXP GENERATE EXX OR E-XX B MOVEIM TEXTC2I LB,R1 *R8 LINK=R13 GET BYTE COUNT OF TEXTC ITEM. SLS,R8 2 AI,R8 1 = BA(TEXT STRING) B MTEMPIM2+1 MOVE THE STRING INTO IMAGE BUFFER. PAGE * * CREALARR-CONVERT REAL ARRAY DATUM TO PRINT FORM IN IMAGE BUFFER * * R13=LINK * R2,R4,R5,R7,R11,R12 USED INTERNALLY * R3 USED AND UPDATED (IMAGE BUFFER POINTER) * * ROUTINES USED:CHEKWID CHECK IF FIELD FITS IN IMAGE * CREALBIN CONVERT TO INTEGER-DEC. EXP. FORM * SETCHAR SET CHARACTER * GENDIGS,GENDIGSE GENERATE DIGITS * GENEXP GENERATE E-FIELD * * FIELD WIDTH IS DIGITS+7 BLANKS AND ZEROS INSERTED AS * FORM INDICATES * LOCAL MAXBLNK,BLOOP,ENDBLNKS,BLOOP2,EFORMARR,ZLOOPE LOCAL NODOT CREALARR LW,R7 DIGITS FIELD WIDTH IS FIXED AI,R7 7 AT DIGITS+7 BAL,R11 CHEKWID CHECK VS IMAGE POSITION BAL,R11 CREALBIN CONVERT TO INTEGER-DEC. EXP. FORM LI,R5 BA(IMAGE) GET ADDRESS AW,R5 R3 TO STASH BYTES LW,R4 R7 SAVE SIGN OR BLANK MTW,0 EFLAG CHECK IF E-FORMAT BNEZ EFORMARR YES LW,R2 DMINP5 NO-CHECK FOR BLANK CI,R12 1 INSERTION REQUIREMENT BLE MAXBLNK MAX BLANK INSERTION AI,R2 1 SW,R2 R12 VARIED BLANK INSERTION MAXBLNK LI,R11 BLOOP LI,R7 BLANK BLOOP BDR,R2 SETCHAR LW,R7 R4 - SIGN OR BLANK BAL,R11 SETCHAR BAL,R4 GENDIGS GENERATE DIGITS AND DEC. PT. ENDBLNKS LW,R2 DIGITS SW,R2 R5 CALCULATE BLANK PAD TO RIGHT AW,R2 R3 FOR FIELD WIDTH DIGITS+7 AI,R2 BA(IMAGE)+8 LI,R7 BLANK GEN. BLANKS LI,R11 BLOOP2 BLOOP2 BDR,R2 SETCHAR AW,R3 DIGITS SET NEW IMAGE POS FOR R3 AI,R3 7 B *R13 EXIT EFORMARR LI,R7 BLANK LEADING BLANK BAL,R11 SETCHAR LW,R7 R4 SIGN OR BLANK BAL,R11 SETCHAR BAL,R4 GENDIGSE DIGITS E FORMAT AI,R12 0 CHECK IF DECIMAL NEEDED BNEZ NODOT NO LI,R8 X'4B' YES-INSERT IT STB,R8 0,R5 AI,R5 1 NODOT LW,R2 DIGITS AI,R2 BA(IMAGE)+4 CALCULATE 0'S PAD TO RIGHT AW,R2 R3 BEFORE GENERATING E-FIELD SW,R2 R5 LI,R7 X'F0' GEN. 0'S LI,R11 ZLOOPE ZLOOPE BDR,R2 SETCHAR LI,R4 ENDBLNKS SET EXIT B GENEXP GENERATE E-FIELD PAGE * * SINGOUT AND MIXEDOUT--EXECUTION OUTPUT ROUTINES * * MIXEDOUT IS CALLED AT THE END OF EXECUTION OF A STATEMENT * IF ONE OR MORE DATA BLOCKS ARE TO BE PRINTED * * SINGOUT IS CALLED FOR QUAD OUTPUT OF A SINGLE DATA BLOCK * * ENTRY CONDITIONS: * MIXEDOUT-R13=# OF BLOCKS TO BE OUTPUT * R1 = POINTER TO LIST OF DATA BLOCK POINTERS(-1) * SINGOUT-R4 CONTAINS DATA BLOCK POINTER * * REGISTER USEAGE: R1-R14 SAVED AND RESTORED * * R14=LINK NORMAL RETURN TO CALL+2 * ERROR RETURN TO CALL+1 (NOT USED) * * * LOCAL NXTBLKOT,BLOCKOUT,GETSIZE,BYTDBASE,NOTDWB,NEXTROW LOCAL ROWLOOP,DECRSIZE,PANELER,DUMPLAST LOCAL QTEXT,LOGICSET,VECTOR,REALVECT,INTVECT1,INTVECT LOCAL REALVSP,INTVSP LOCAL LOGTEXT MIXEDOUT STW,R13 BLOCKNUM STW,R1 PTRPTR LCI 14 SAVE STM,R1 SAVE114 R1 TO R14 NXTBLKOT MTW,1 PTRPTR UPDATE POINTER TO DBPTR LW,R4 *PTRPTR GET NEXT DBPTR B BLOCKOUT SINGOUT LCI 14 SAVE STM,R1 SAVE114 R1 TO R14 LI,R3 0 SET IMAGE OFFSET 0 STW,R3 BLOCKNUM FLAG SINGLE BLOCK ENTRY BLOCKOUT LI,R15 % FOR ERROR INFO IF SYSTERR LB,R2 *R4 GET DATA TYPE IN R2 BEZ SYSTERR INVALID DATA TYPE CI,R2 5 BG EMPTY INVALID DATA TYPE-TREAT AS EMPTY BE INDSEQ INDEX-SEQUENCE SPECIAL CASE LI,R7 1 LB,R6 *R4,R7 GET RANK IN R6 BEZ SCALAR CI,R6 1 BE VECTOR STW,R6 RANKARR ARRAY-SAVE RANK AI,R4 1 STW,R4 LBASEM1 SAVE BASE-1 OF LENGTH VALUES LW,R9 *LBASEM1,R6 STW,R9 ROWSIZE SAVE LAST DIMENSION-ROW SIZE LI,R9 1 GETSIZE MW,R9 *LBASEM1,R6 SIZE=PRODUCT OF LENGTHS BEZ EMPTY BDR,R6 GETSIZE STW,R9 DSIZE SET NUMBER OF UNITS IN BLOCK AW,R4 RANKARR R4 POINTS TO LAST LENGTH WORD AI,R4 1 NOW TO FIRST DATA WORD QTEXT CI,R2 2 CHECK TYPE FOR TEXT BL LOGICSET BE BYTDBASE YES CI,R2 4 CHECK IF SHIFT TO DW BOUND NEEDED BNE NOTDWB NO AI,R4 1 YES-INSURE DW BOUND AND,R4 FFFFFFFE B NOTDWB LOGICSET LI,R11 32 SET INITIAL COUNT STW,R11 BITCOUNT FOR LOGIC VALUE OUTPUT B NOTDWB BYTDBASE SLS,R4 2 SHIFT R4 TO BYTE ADDRESSING NOTDWB STW,R4 DBASE SAVE ADDRESS OF DATA AI,R6 0 CHECK FOR VECTOR (TEXT OR LOGIC) BNEZ CVARRTBL-1,R2 YES-SHORTCUT CI,R2 3 NO-CHECK FOR INTEGER OR REAL ARRAY BGE GETRANGE-3,R2 YES-GET RANGE OF VALUES(ABSOLUTE) SETCONV LW,R9 CVARRTBL-1,R2 NO STW,R9 CONVRTR TO FETCH & CONVERSION ROUTINES LW,R9 BLOCKNUM CHECK IF NOT 1ST DATA BLOCK BLEZ NEXTROW FIRST-NO PROBLEM BAL,R12 DUMPLING LATER-GENERATE RESIDUAL IMAGE NEXTROW LW,R10 ROWSIZE SET LOOP LI,R13 DECRSIZE SET EXIT FROM CONVERT SUBROUTINES ROWLOOP EXU CONVRTR PROCESS DKTUM DECRSIZE MTW,-1 DSIZE DECREMENT TOTAL COUNT BEZ LASTROW QUIT IF DONE BDR,R10 ROWLOOP LOOP ON ROWSIZE LINEOUT BAL,R12 DUMPLING DUMP LINE WITH CR,RESET R3=0 LW,R6 RANKARR SET RANK FOR LOOP AI,R6 -1 REDUCE TO RANK-1 LI,R4 0 LW,R5 DSIZE GET REMAINING DATA COUNT DW,R4 ROWSIZE DIVIDE BY ROW SIZE PANELER DW,R4 *LBASEM1,R6 USE REMAINDER TEST TO DETERMINE AI,R4 0 PANEL SEPARATION BNEZ NEXTROW REMAINDER NOT=0, NO MORE BLANKS LI,R8 BLANKS SET TO LI,R9 1 OUTPUT BAL,R7 WROUTWB A SINGLE BLANK WITH CR BDR,R6 PANELER LOOP (SHOULD NOT FALL THROUGH) LASTROW MTW,-1 BLOCKNUM LAST ROW-CHECK IF LAST(OR ONLY) BLK BGZ NXTBLKOT NO DUMPLAST BAL,R12 DUMPLING YES-OUTPUT WITH CR OUTEXIT LCI 14 RESTORE LM,R1 SAVE114 R1 TO R14 AI,R14 1 INCREMENT FOR CALL+2 RETURN B *R14 RETURN EMPTY MTW,-1 BLOCKNUM CHECK IF MORE DATA BLOCKS BGZ NXTBLKOT YES-CONTINUE PROCESSING AI,R3 0 NO-CHECK IF IMAGE IS EMPTY BEZ OUTEXIT YES-EXIT B DUMPLAST NO * * VECTOR-SET UP TO PROCESS VECTOR FOR OUTPUT * VECTOR LI,R6 0 SET INDEX AI,R4 2 POINT TO LENGTH OF VECTOR LW,R10 *R4 GET LENGTH IN R10 FOR LOOP BEZ EMPTY AI,R4 1 POINT TO FIRST DATA WORD (UNLESS DW) CI,R2 3 CHECK TYPE BL LOGTEXT LOGIC OR TEXT BE INTVECT1 INTEGER VECTOR-READY TO PROCESS AI,R4 1 REAL-SKIP TO DW BOUND STW,R4 DBASE SAVE DATA BASE ADDRESS REALVECT LW,R8 BREAKFLG CHECK FOR BREAK BNEZ OUTEXIT YES LD,R8 *DBASE,R6 NO-GET DATUM AI,R6 1 BAL,R13 CREALIM CONVERT IT BDR,R10 REALVSP GO SET SPACES (UNLESS DONE) B LASTROW DONE! REALVSP BAL,R11 STASHBL BAL,R11 STASHBL B REALVECT LOOP INTVECT1 STW,R4 DBASE SAVE BASE ADDRESS OFDATA INTVECT LW,R8 BREAKFLG CHECK FOR BREAK BNEZ OUTEXIT YES LW,R8 *DBASE,R6 NO-GET DATUM AI,R6 1 BAL,R13 CINTIM CONVERT IT BDR,R10 INTVSP GO SET SPACES (UNLESS DONE) B LASTROW DONE! INTVSP BAL,R11 STASHBL BAL,R11 STASHBL B INTVECT LOOP LOGTEXT STW,R10 DSIZE SAVE DATA SIZE STW,R10 ROWSIZE ALSO ROW LENGTH STW,R6 RANKARR FAKE RANK 0 ON VECTOR LI,R6 1 SET TO CATCH VECTOR B QTEXT REENTER ARRAY ROUTINE * * GETRANGE-GET MAGNITUDE RANGE OF INTEGER OR REAL ARRAY * LOCAL RNGLOOP,UPINDEX,EFORM,CHEKHI,INTRANGE,MAGLOOP LOCAL KIKINDX,DMXLOOP,SETDMAX GETRANGE B INTRANGE INTEGER LD,R8 ZEROZERO STD,R8 HIREAL PRESET HIREAL LD,R8 MAXREAL STD,R8 LOREAL AND LOREAL LW,R10 DSIZE RNGLOOP LAD,R8 *DBASE,R6 GET DATUM BNEZ %+2 SKIP IF NOT ZERO LD,R8 FLONE REPLACE ZERO BY ONE CD,R8 LOREAL CHECKLO BGE CHEKHI STD,R8 LOREAL UPDATE LOW UPINDEX AI,R6 1 BDR,R10 RNGLOOP LOOP LD,R8 LOREAL GET LOW VALUE BAL,R11 CREALBIN FIND DECIMAL POSITION CI,R12 -3 CHECK IF LOW BL EFORM YES-E FORMAT INDICATED AI,R12 5 STW,R12 DMINP5 SET DMINP5-USED BY CREALARR ROUTINE LD,R8 HIREAL GET HIGH VALUE BAL,R11 CREALBIN CHECK DECIMAL POSITION CW,R12 DIGITS VS DIGITS BG EFORM TOO-HIGH,EFORM CW,R12 DMINP5 VS DMINP5 BGE EFORM RANGE TOO WIDE-EFORM LI,R11 0 RESET EFLAG EFORM STW,R11 EFLAG LI,R2 4 RESTORE TO 'REAL' TYPE B SETCONV PROCEED-AT LAST-TO CONVERSION CHEKHI CD,R8 HIREAL CHECK VS HIREAL BLE UPINDEX STD,R8 HIREAL UPDATE B UPINDEX * INTRANGE STW,R6 DMAX INTEGER ARRAY RANGE CHECK LW,R10 DSIZE SET LOOP MAGLOOP LAW,R8 *DBASE,R6 GET DATUM CW,R8 DMAX CHECK BLE KIKINDX STW,R8 DMAX UPDATE DMAX KIKINDX AI,R6 1 BDR,R10 MAGLOOP LOOP LI,R6 10 LW,R8 DMAX GET HIGHEST VALUE DMXLOOP CW,R8 TENSTBL-1,R6 CHECK # OF DIGITS BGE SETDMAX BDR,R6 DMXLOOP LOOP SETDMAX STW,R6 DMAX SET # OF DIGITS B SETCONV PROCEED WITH OUTPUT CONVERSION * * INDSEQ-INDEX SEQUENCE OUTPUT CONVERTER * LOCAL INDLOOP,FIRSTOUT INDSEQ AI,R4 2 LW,R10 *R4 GET COUNT BEZ EMPTY MIGHTY SHORT INDEX SEQUENCE! AI,R4 1 LW,R8 *R4 GET BASE INTEGER STW,R8 DBASE AI,R4 1 GET ADDEND INTEGER LW,R9 *R4 STW,R9 DSIZE B FIRSTOUT OUTPUT FIRST ELEMENT AND LOOP INDLOOP BAL,R11 STASHBL GENERATE BAL,R11 STASHBL BLANK SPACERS LW,R8 BREAKFLG BREAK TEST BNEZ OUTEXIT SCRAM! FIRSTOUT LW,R8 DBASE AW,R8 DSIZE UPDATE ELEMENT STW,R8 DBASE BAL,R13 CINTIM OUTPUT ELEMENT BDR,R10 INDLOOP LOOP B LASTROW EXIT * * SCALAR-PROCESSOR FOR SCALAR OUTPUT * LOCAL SCALTYPE,SCALTEXT,SCALOGIC,SETLOGIC,ONBIT SCALAR LI,R13 LASTROW SET EXIT AI,R4 2 POINT TO DATUM LD,R8 *R4 GET DW (MAY ONLY NEED PART OF IT) SCALTYPE B SCALTYPE,R2 VECTOR ON TYPE 1-4 @@@@@@@ B SCALOGIC 1-LOGIC @ B SCALTEXT 2-TEXT @ B CINTIM 3-INTEGER @ B CREALIM 4-REAL @@@@@@@ SCALTEXT LB,R4 *R4 GET CHARACTER B GENTEXT1 SCALOGIC BLZ ONBIT CHECK IF 1-BIT LI,R8 X'F0' NO SETLOGIC LI,R11 LASTROW B STASHIM STASH 1 OR 0 BYTE ONBIT LI,R8 X'F1' B SETLOGIC * * LOGICOUT-OUTPUT FOR LOGIC VECTOR OR ROW OF LOGIC ARRAY * LOCAL NEWORD,TESTBIT,ABIT,BITSHIFT,SBLNKS,LOGARRAY,ONEBIT LOGICOUT LW,R7 BITCOUNT GET BIT POS IN WORD NEWORD LW,R9 *DBASE GET WORD TESTBIT CW,R9 BITPOS-32,R7 CHECK BIT BANZ ONEBIT 1 LI,R8 X'F0' 0 ABIT LW,R11 BREAKFLG CHECK FOR BREAK BNEZ OUTEXIT YES-QUIT BAL,R11 STASHIM NO-SET BIT BDR,R10 SBLNKS LOOP ON ROWSIZE LW,R10 DSIZE END OF ROW SW,R10 ROWSIZE ADJUST DSIZE BEZ LASTROW DONE! STW,R10 DSIZE BDR,R7 BITSHIFT UPDATE BIT POINTER MTW,1 DBASE (AND WORD IF NECESSARY) LI,R7 32 BITSHIFT STW,R7 BITCOUNT B LINEOUT OUTPUT THE ROW SBLNKS BAL,R11 STASHBL SET BLANK LW,R11 RANKARR CHECK VECTOR VS ARRAY BNEZ LOGARRAY ARRAY BAL,R11 STASHBL VECTOR-2 BLANKS BETWEEN VALUES LOGARRAY BDR,R7 TESTBIT MTW,1 DBASE LI,R7 32 B NEWORD ONEBIT LI,R8 X'F1' B ABIT SET '1' BYTE * * TEXTOUT-PROCESS TEXT VECTOR OR ROW OF TEXT ARRAY * TEXTOUT LW,R6 DBASE GET DATA ADDRESS AWM,R10 DBASE UPDATE FOR NEXT PASS BAL,R13 GENTEXTM GENERATE ROW OF TEXT LW,R10 DSIZE SW,R10 ROWSIZE UPDATE REMAINING DATA SIZE BEZ LASTROW QUIT IF LAST ROW LW,R13 BREAKFLG CHECK FOR BREAK BNEZ OUTEXIT YES-EXIT STW,R10 DSIZE B LINEOUT * * INTARRAY-PROCESS ELEMENT IN INTEGER ARRAY * INTARRAY LW,R8 BREAKFLG CHECK BREAK BNEZ OUTEXIT YES-QUIT LW,R8 *DBASE GET DATUM MTW,1 DBASE KICK POSITION B CINTARR CONVERT AND OUTPUT * * REALARRY-PROCESS ELEMENT IN REAL ARRAY * REALARRY LW,R8 BREAKFLG CHECK BREAK BNEZ OUTEXIT YES-QUIT LD,R8 *DBASE GET DATUM MTW,2 DBASE KICK POSITION B CREALARR CONVERT AND OUTPUT * * CVARRTBL-PROGRAM SWITCHES-SET IN CONVRTR * CVARRTBL B LOGICOUT B TEXTOUT B INTARRAY B REALARRY PAGE * * GENCHAR-GENERATE A CHARACTER OR MNEMONIC IN IMAGE * * R13=LINK * ON ENTRY:R7 CONTAINS INTERNAL FORM OF CHARACTER * R3 IS IMAGE OFFSET TO STASH CHARACTER * * INTERNALLY, R2,R7, AND R14 USED AND CHANGED * * ON EXIT: R3 IS IMAGE OFFSET FOR NEXT CHARACTER * * THIS ROUTINE DOES NOT PERFORM WIDTH CHECK * LOCAL GENLOOP,ONECHAR GENCHAR LB,R2 OUTMNEMT,R7 CHECK CHARACTER CLASS BEZ ONECHAR 1 FOR 1 CI,R2 4 BGE ONECHAR OVSTK-LEAVE AS IS LB,R7 OUTRANST,R7 MNEMONIC-EXPAND IT (GET OFFSET) AW,R7 MNEMTN-1,R2 BA OF MNEMONIC AI,R2 1 LOOP SIZE LI,R14 X'43' APL % GENLOOP STB,R14 IMAGE,R3 AI,R3 1 LB,R14 0,R7 MNEMONIC CHARACTER AI,R7 1 BDR,R2 GENLOOP LOOP B *R13 ONECHAR STB,R7 IMAGE,R3 SINGLE CHARACTER AI,R3 1 B *R13 EXIT PAGE * * CNAMEIM-CONVERT A NAME-MOVE TO IMAGE BUFFER * * ON ENTRY:R3 IS OFFSET PTR FOR IMAGE * R6 POINTS AT 2ND BYTE OF NAME POINTER * R5 IS NAME ENTRY OFFSET FROM SYMT * R4 IS FLAG -1=STOPNAME 0=TRACENAME 1=NAME * R13 IS LINK * * REGISTERS R1 TO R12-EXCEPT R6-ARE USED AND CHANGED * * GENNAME IS AN ALTERNATE ENTRY WHICH DOES NOT CHECK FOR STOP OR TRACE * FOR THIS ENTRY, R8 IS THE NAME OFFSET TO SYMT * * * ON EXIT, R6 IS UNCHANGED. R3 POINTS TO NEW OFFSET IN IMAGE * * MNEMONICS ARE EXPANDED IF ENCOUNTERED,AND THE NAME IS FORMED * IN 'NAMETEMP' * 'CHEKWID' IS USED TO CHECK FOR WIDTH OVERRUN-IF SO,IMAGE IS * DUMPED PRIOR TO MOVING THE NAME FROM NAMETEMP TO IMAGE * LOCAL CNAM1,CNAM2,CNAM3,CNAM4,LONGNAME LOCAL STUFNAM1,STUFNAM2,STUFNAM3,STUFNAM4 LOCAL CNAM5,CNAM6 GENNAME0 LI,R1 1 STW,R1 SAVE212 SET FLAG-NO INDENT ON WIDTH OVERFLOW LI,R1 0 B CNAM2 GENNAME LI,R1 0 SET NAMETEMP POINTER STW,R1 SAVE212 SET FLAG FOR INDENT ON WIDTH OVERFLO B CNAM2 BYPASS STOP-TRACE CHECKS CNAMEIM LI,R1 0 SET NAMETEMP POINTER STW,R1 SAVE212 SET FLAG FOR INDENT ON WIDTH OVRFLOW LI,R2 'S' PRESET STOP-NAME LW,R8 R5 SAVE SYMT OFFSET IN R8 AI,R4 0 CHECK NAME-TYPE FLAG BGZ CNAM2 PLAIN NAME BLZ CNAM1 STOP LI,R2 'T' TRACE CNAM1 BAL,R11 STUFNAM4 SET S OR T LI,R2 X'48' BAL,R11 STUFNAM1 SET DELTA OR %DLT CNAM2 AW,R8 SYMT GET SYMBOL ADDRESS AI,R8 1 LB,R10 *R8 CHECK NAME TYPE CI,R10 BLANK BL LONGNAME LI,R10 4 SHORT NAME-SET LOOP TO 4 CNAM3 LI,R4 0 SET POINTER FOR NAMETEMP CNAM4 LB,R2 *R8,R4 GET BYTE AI,R4 1 BAL,R11 STUFNAM1 SET BYTE-OR MNEMONIC BDR,R10 CNAM4 LOOP CNAM5 LW,R2 SAVE212 GET FLAG FOR WIDTH OVERFLOW ACTION B CNAM6,R2 CNAM6 B MTEMPIM INDENT-USE MTEMPIM LW,R7 R1 NO IDENT AW,R7 R3 CHECK WIDTH CW,R7 WIDTH BL MTEMPIM2 OK-MBS BAL,R12 DUMPLING OVERFLOW-DUMP LINE FIRST B MTEMPIM2 NOW-MBS LONGNAME SLS,R10 2 LW,R8 *R8 AND,R8 X1FFFF ADDRESS MASK B CNAM3 STUFNAM1 LB,R5 OUTMNEMT,R2 GET MNEMONIC FLAG BEZ STUFNAM3 NOT MNEMONIC-CHECK FOR BLANK CI,R5 4 MAYBE BGE STUFNAM4 NOT MNEMONIC OR BLANK CI,R1 251 CHECK FOR TOO DAMN BIG BG CNAM5 YES-TRUNCATE LB,R7 OUTRANST,R2 MNEMONIC-GET TABLE OFFSET AW,R7 MNEMTN-1,R5 ADD TABLE ADDRESS LI,R2 X'43' SET '%' AI,R5 1 SET MNEMONIC SIZE LOOP STUFNAM2 STB,R2 NAMETEMP,R1 STASH % AND MNEMONIC NAME AI,R1 1 LB,R2 0,R7 AI,R7 1 BDR,R5 STUFNAM2 LOOP B *R11 EXIT STUFNAM3 CI,R2 BLANK BLANK CHECK BE CNAM5 YES-END OF SCAN STUFNAM4 STB,R2 NAMETEMP,R1 STORE NON-BLANK CHAR AI,R1 1 CI,R1 255 CHECK FOR GROSS OVERFLOW BLE *R11 NO-RETURN B CNAM5 YES-TRUNCATE PAGE * * FUNLDISP-DISPLAY FUNCTION NAME AND LINE NO. * (FUNLDIS% - ALT.ENTRY, R6 HAS CURRLINO & NAME PTR AND * R8 HAS NAME PTR FOR FUNCTION.) * * R14=LINK * * ON ENTRY,R1 POINTS TO F STACK ENTRY * NAME AND LINE # SET IN IMAGE STARTING AT POSITION 0 * ON EXIT R3 IS NEXT IMAGE BYTE OFFSET * R6 CONTAINS CURRLINO AND FDEFPTR * NO REGISTERS ARE SAVED-MOST ARE USED * FUNLDISP LW,R6 1,R1 GET CURRLINO AND FDEFPTR IN R6 LW,R8 FNOFF,R6 GET NAME POINTER IN R8 FUNLDIS% LI,R3 0 START AT BYTE 0 IN IMAGE BAL,R13 GENNAME CONVERT NAME & MOVE TO IMAGE LI,R4 X'B4' BAL,R13 GENTEXT1 LEFT BRACKET-MAY BE MNEMONIC LH,R8 R6 SLS,R8 -1 GET FUNCTION LINE # BAL,R13 CINTIM CONVERT LI,R4 X'B5' BAL,R13 GENTEXT1 RIGHT BRACKET(MAY BE MNEMONIC) BAL,R11 STASHBL TWO BLANKS BAL,R11 STASHBL FOR SPACING B *R14 AND EXIT PAGE * * SHOWSTOP-GENERATE STOP DISPLAY-EXIT TO INPDIR * SHOWSTOP BAL,R14 FUNLDISP DISPLAY FUNCTION NAME-LINE NUMBER BAL,R12 DUMPLING B INPDIR GO TO DIRECT INPUT PAGE * * SIDR-(HOW ABOUT THAT!)-ROUTINE TO WARN USER THAT SI DAMAGE WILL * RESULT IF HE CLOSES THE CURRENTLY OPEN FUNCTION * * RESPONSE IS REQUESTED: GO MEAN3 PROCEED TO CLOSE * * R14=LINK RETURN IS VIA R14 WITH CONDITION CODES AS INDICATOR * 'EQUAL' MEANS GO * SIDR LW,R7 ON%OFF BEZ *R14 OFF-LINE,ASSUME 'GO' AW,R7 BREAKFLG (ON%OFF=1) BLEZ *R14 BREAKFLG NEG.=HANGUP='GO' LI,R8 SIDAMSG BAL,R7 WRTEXTC GENERATE MESSAGE LI,R8 0 BAL,R11 RDAPL+1 READ RESPONSE LH,R7 INBUF CH,R7 GOMSG CHECK VS 'GO' B *R14 SIDAMSG TEXTC 'SI DAMAGE WILL RESULT:TYPE ''GO'' TO CLOSE' GOMSG TEXT 'GO ' PAGE * * SHOWFL-ROUTINE TO DISPLAY FUNCTION LINE OR HEADER * * ENTRY CONDITIONS:1. R14=LINK, MERGECOL IS SET NEGATIVE * DISPLAY ONLY,RETURN VIA R14 * 2. MERGECOL=0 GENERATE LINE AS PROMPT-EXIT TO * FIHANDLER * 3. MERGECOL POSITIVE-GENERATE LINE AND BLANK PROMPT * TO MERGECOL-1, EXIT TO EDITCTRL * * A. CURRCS=0 NO DECODESTRINGING REQUIRED * * B CURRCS=PTR TO CS OLOCK-DECODESTRINGING REQUIRED * LOCAL SAVNBLNK SHOWFL STW,R3 IMAGEPOS SET NO.OF BYTES ALREADY IN IMAGE LW,R12 CURRCS CHECK LINE VS HEADER BNEZ DECODOPS LINE-REQUIRES DECODESTRING LW,R12 MERGECOL CHECK DISPLAY-APPEND-EDIT BEZ INPF APPEND BAL,R12 DUMPLING DISPLAY OR EDIT LW,R3 IMAGEPOS GET NO. OF BYTES DECODRTN LI,R12 0 STW,R12 CURRCS RESET CURRCS (NO DREF NEEDED) LW,R12 MERGECOL GET NO. OF BYTE) BLZ *R14 DISPLAY BEZ INPFAPND APPEND. MTW,-1 IMAGES CHECK FOR MULTI-LINE DISPLAY BGZ BREPROMT YES -- CAN'T BE EDITED. LI,R7 X'15' CR STB,R7 IMAGE,R3 INSERT FOR VISIMAGE LI,R7 33 (132 BYTES) LW,R9 BLANKS SAVNBLNK LW,R8 IMAGE-1,R7 STW,R8 VISIMAGE-1,R7 SAVE IMAGE IN VISIMAGE STW,R9 IMAGE-1,R7 BLANK IMAGE BDR,R7 SAVNBLNK LOOP LW,R3 MERGECOL AI,R3 -1 BAL,R11 PRMTIMAG BAL,R11 APLINPUT B BRFUNDEF RETURN FOR EDIT-CTRL. PAGE * * * DECODESTRING OPERATIONS * * THE FOLLOWING ROUTINES COVER CONVERSION OF CODESTRING TO * LINE IMAGE(S) FOR OUTPUT DISPLAY. * * THE ROUTINES ARE ACCESSED FOR EXECUTION ERROR DISPLAYS * AND FOR DISPLAYS ASSOCIATED WITH FUNCTION EDITING. * * DECODESTRINGING IS A 3 PHASE PROCESS * * 1. SCAN CODESTRING RIGHT TO LEFT. * WHENEVER A MULTI-BYTE ITEM IS ENCOUNTERED THE * KEY BYTE IS ON THE RIGHT. ANY LENGTH BYTE OR * HALFWORD FOLLOWS. THE DATA IS TO THE LEFT BUT * IS INTERNALLY ORDERED LEFT-RIGHT. * * PASS 1 'FLIPS' THE DATA-LENGTH-KEY SEQUENCE * TO KEY-LENGTH-DATA * * 2. SCAN MODIFIED CODESTRING LEFT TO RIGHT * THIS IS THE BUSY PHASE. CHARACTERS ARE SCANNED * LEFT TO RIGHT. SINGLE BIT CODESTRING CHARACTERS * GENERATE CHARAETERS,SKIPS,OR MULTI-CHARACTER * MNEMONICS IN 'IMAGE' * MULTI-BIT CODESTRING ITEMS REQUIRE CONVERSION: * NAME LOOKUP ( NAME, S NAME, OR T NAME ) * NUMERIC CONVERSION-SCALARS & VECTORS-INTEGER & REAL * TEXT CONVERSION-TEXT SCALARS & VECTORS & COMMENTS * ERROR LOCATION IS TRACKED FOR POSITIONING ERROR CARET * IMAGE LINE-OR LINES-ARE OUTPUT * * IF INDICATED,ERROR CARET LINE IS PRODUCED * * 3. SCAN CODESTRING LEFT TO RIGHT * REVERSE PROCESS OF PHASE 1. * * ***** ***** * * * * * PHASE 1-PHASE 3 SEQUENCE IS CRITICAL-BREAKS SHOULD NOT * * * BE HONORED IN THIS SEQUENCE EXCEPT TO SQUELCH THE * * * PHYSICAL DISPLAY. IF, FOR ANY REASON, THE SEQUENCE * * * CANNOT BE COMPLETED, SYSTEM ERROR AND CLEAR SHOULD * * * BE EXECUTED * * * * * ***** ***** * PAGE LOCAL EDECODOP EQU DECODOPS ERROR CALL TO DECODOPS. DECODOPS LW,R6 CURRCS POINTER TO CODESTRING BLOCK+2 LI,R15 % *FOR ERROR INFO IS SYSTERR AI,R6 -2 *POINT TO BLOCK LB,R8 *R6 * CHECK BLOCK TYPE AI,R8 -CSBLOCK * BNEZ SYSTERR *NOT CODESTRING-SYSTEM ERROR LW,R6 CURRCS LH,R8 *R6 OFFSET SLS,R6 2 BA(OFFSET) AI,R6 1 LI,R10 CSEND DECODET OFFSET FOR EOS FLAG STB,R10 0,R6 SET LEFT-END STOP AW,R6 R8 END OF CS+1 LB,R9 0,R6 GET BYTE TO RIGHT OF CODESTRING STB,R10 0,R6 SET RIGHT-END STOP STB,R9 R8 R8-BYTE 3=LEFT END-1,BYTE 0=RT END+1 STW,R8 SAVENDS LI,R11 -1 SET RIGHT-LEFT SCAN B STEP1 MOVE LEFT 1 BYTE AND START * * PHASE 1 & PHASE 3 PROCESSOR(DEPENDING ON R11) * * RIGHT-LEFT OR LEFT-RIGHT SCAN TO FLIP-OR-FLOP MULTIBYTE CODESTRING * ITEMS. * LOCAL PICKBYTE,SHIFTN,SHIFTV,STEPN,STEP3,STEP5,STEP9,STEP2 LOCAL LFACT,BITS,LONGTEXT,LONGT1,LONGT2,ENDFLIP PICKBYTE LB,R5 0,R6 GET BYTE FROM CODESTRING CI,R5 CSEND CHECK RANGE BG SYSTERR !IMPOSSIBLE! LB,R4 DECODET,R5 DECODE BYTE CI,R4 X'11' CHECK IF MULTI-BYTE ENTRY BG STEP1 NO-SKIP IT BE ENDFLIP EOS-STOP FLIP-FLOP SCAN AI,R4 -2 CHECK TYPE OF SPECIAL CODESTRING BLEZ STEP1 SINGLE CHARACTER-SKIP IT LW,R3 R6 SET POINTER AW,R3 R11 TO NEXT BYTE (MAY BE LENGTH) LB,R9 0,R3 R9=2ND BYTE AI,R4 -2 BLEZ STEP2 2 CHARACTER SET-FLIP THEM AI,R4 -4 BLZ STEP3 3 CHARACTERS BEZ STEP5 5 CHARACTERS AI,R4 -2 BLZ STEP9 9 CHARACTERS AW,R3 R11 SET TO 3RD BYTE CI,R4 6 BE LONGTEXT LENGTH IS 2 BYTES LW,R10 R9 SET LOOP COUNTER TO LENGTH BEZ STEP2 EMPTY TEXT VECTOR OR NULL COMMENT LI,R12 STEP2 SET EXIT FROM BYTE-SHIFT LOOP EXU LFACT,R4 GET BYTE COUNT FROM LENGTH B SHIFTV ENTER BYTE-SHIFT LOOP SHIFTN LI,R12 STEPN SHIFTV LB,R7 0,R3 BYTE SHIFT STB,R7 0,R6 LOOP AW,R6 R11 AW,R3 R11 BDR,R10 SHIFTV B *R12 EXIT STEP2 STB,R9 0,R6 STORE 2ND BYTE AW,R6 R11 STEPN STB,R5 0,R6 STORE KEY BYTE STEP1 AW,R6 R11 MOVE TO NEXT BYTE B PICKBYTE STEP3 LI,R10 2 NAME ITEM HW+KEY BYTE B SHIFTN STEP5 LI,R10 4 INTEGER WORD SCALAR B SHIFTN STEP9 LI,R10 8 REAL DW SCALAR B SHIFTN * LFACT-EXU VECTOR LFACT B BITS LOGIC VECTOR @@@@@@@ B SHIFTV BYTE-FIELD @ B SHIFTV BYTE-FIELD @ SLS,R10 2 WORD FIELD-COUNT=4*L @ SLS,R10 3 DW FIELD-COUNT=8*L @ B SHIFTV BYTE FIELD @@@@@@@ * BITS AI,R10 7 SLS,R10 -3 GET BYTE COUNT FROM BIT COUNT B SHIFTV * LONGTEXT LB,R4 0,R3 GET 3RD BYTE-PART OF L AW,R3 R11 MOVE TO 4TH BYTE CI,R11 -1 CHECK DIRECTION BE LONGT1 RIGHT-LEFT XW,R9 R4 LEFT-RIGHT,SWITCH BYTES 2 & 3 LONGT1 LW,R10 R4 R4=L1 SLS,R10 8 R9=L2 AW,R10 R9 R10=LENGTH CI,R11 -1 BNE LONGT2 LEFT-RIGHT XW,R9 R4 RIGHT-LEFT,SWITCH BYTES 2 & 3 LONGT2 BAL,R12 SHIFTV SHIFT L BITS STB,R4 0,R6 SET L1 OR L2 AW,R6 R11 B STEP2 FINISH LAST 2 BYTES * ENDFLIP CI,R11 -1 CHECK PHASE BNE DECODEND PHASE 3- LW,R11 SAVENDS STB,R11 0,R6 RESTORE 2ND BYTE OF OFFSET LI,R11 0 STD,R11 IMAGES AND IMMERBYT PRESET FOR PHASE 2 STW,R11 LASTSCAN @@@@ LW,R3 CURRCS GET ADDRESS OF CS SLS,R3 2 FORM BYTE ADDRESS MTW,0 MODE CHECK MODE BNEZ ERRDISPL ERROR DISPLAY AI,R3 10000 FUNCTION EDIT-SET LARGE VALUE B DECODOUT ERRDISPL AW,R3 OFFSET * @ * PHASE 2-SCAN LEFT-RIGHT AND GENERATE LINE DISPLAY @ * @ LOCAL PASSERR,SETBYTE,CHEKMNEM,RESLAST,HARDWAY @ LOCAL TEXT,TEXT1,COMMENT,NOTEXT,REALV1,REALV,REAL1 @ LOCAL INTV1,INTEGERV,INTEGER1,INTEGERB,LOGICV,LOGICV1 LOCAL LOGICV2,YES,NXTBIT,NAME DECODOUT STW,R3 CSERRBYT SET CS ERROR BA (OR HI VALUE) LW,R3 IMAGEPOS SKIP AI,R6 1 COMPBYTE CW,R6 CSERRBYT CHECK IF PAST ERROR POSITION BL PASSERR NO-OR NO ERROR INDICATED MTW,0 IMERRBYT CHECK IF ERROR CARET ALREADY SET BNEZ PASSERR YES STW,R3 IMERRBYT NO-SET ERROR CARET POSITION PASSERR LB,R5 0,R6 R5=CS VALUE LB,R4 DECODET,R5 R4=APL INTERNAL OR SPECIAL INDIC. CI,R4 X'11' CHECK FOR SPECIAL BL HARDWAY SPECIAL BE ENDCONV EOS-QUIT DISPLAY CI,R5 9 SINGLE CHAR-CHECK DIGIT BG CHEKMNEM NO BAL,R11 QSTASHBL YES-SET BLANK IF LASTSCAN INDICATES SETBYTE LW,R8 R4 R8=INTERNAL APL CHAR. LI,R11 SKIP SET EXIT B STASHIM SET BYTE * CHEKMNEM LB,R7 OUTMNEMT,R4 CHECK IF BYTE IS MNEMONIC FOR BEZ RESLAST OUTPUT DEVICE CI,R7 4 BGE RESLAST NO BAL,R11 QSTASHBL YES-SET BLANK IF LASTSCAN INDICATES BAL,R5 GENMNEM GENERATE MNEMONIC B SKIP * * RESLAST-RESET LASTSCAN=0 AND SET BYTE * RESLAST LI,R8 0 STW,R8 LASTSCAN B SETBYTE * * HARDWAY-START OF PROCESSING FOR SPECIAL CS ITEMS * HARDWAY CI,R4 3 BL SKIP DUMMY,BOS BE TEXT1 AI,R6 1 LB,R10 0,R6 GET 2ND BYTE CI,R4 X'B' CHECK FOR TEXT VECTOR BL NOTEXT BE TEXT CI,R4 X'C' CHECK FOR COMMENT BE COMMENT CI,R4 X'F' CHECK FOR LINE-SCAN ERROR BE LSCERR YES BL NOTEXT AI,R6 1 GET L2 LB,R11 0,R6 SLS,R10 8 AW,R10 R11 SET TEXT BYTE COUNT IN R10 TEXT LI,R8 X'7D' SET LEADING QUOTE BAL,R11 STASHIM CSGNTEXT BAL,R13 GENTEXT LI,R4 X'7D' B RESLAST SET CLOSING QUOTE AND RESET LASTSCAN * TEXT1 LI,R10 1 B TEXT * COMMENT AI,R10 1 KICK COUNT FOR COMMENT CHARACTER LI,R4 X'59' COMMENT CHARACTER BAL,R13 GENTEXTC B SKIP * * LSCERR LINE-SCAN ERROR-TEXT+ERROR POINTER * LSCERR AW,R6 R10 MOVE TO ERROR POINTER LB,R5 0,R6 GET IT SW,R6 R10 MOVE BACK LW,R4 R3 GET IMAGE POINTER AW,R4 R10 ADD LENGTH SW,R4 R5 SUBTRACT ERROR POINTER AI,R4 -1 1 MORE MTW,0 MODE CHECK IF DISPLAY BEZ %+2 YES-DONT INDICATE ERROR STW,R4 IMERRBYT SAVE IMAGE ERROR POSITION AI,R10 -1 DONT COUNT THE ERROR POINTER AS TEXT BAL,R13 GENTEXT GENERATE TEXT AI,R6 1 SKIP THE ERROR POINTER B SKIP PROCEED (SHOULD HIT END NEXT) * * NOTEXT BAL,R11 QSTASHBL INSERT BLANK IF NEEDED -SET LASTSCAN CI,R4 4 BE INTEGERB BYTE INTEGER CI,R4 8 BL NAME NAME,STOP-NAME,OR TRACE-NAME BE INTEGER1 SCALAR INTEGER CI,R4 9 BE REAL1 SCALAR REAL AI,R6 1 MOVE TO 3RD BYTE CI,R4 X'D' BE INTEGERV INTEGER VECTOR BL LOGICV LOGIC VECTOR B REALV REAL VECTOR-LENGTH IN R10 REALV1 BAL,R11 STASHBL SET INTERVENING BLANK REALV LW,R7 SET89 SET TO MOVE FROM ADDRESS IN R6 MBS,R6 0 TO R8-R9 BAL,R13 CREALIM CONVERT AND STORE IN IMAGE BDR,R10 REALV1 B COMPBYTE REAL1 LI,R10 1 SET COUNT TO 1 B REALV SET89 DATA X'08000020' MBS 8 BYTES TO R8-R9 * INTV1 BAL,R11 STASHBL SET INTERVENING BLANK INTEGERV LW,R7 SET8 SET TO MOVE FROM CS TO R8 MBS,R6 0 LOAD R8 BAL,R13 CINTIM CONVERT AND STASH BDR,R10 INTV1 LOOP B COMPBYTE EXIT INTEGER1 LI,R10 1 INTEGER SCALAR B INTEGERV INTEGERB LW,R8 R10 1 BYTE INTEGER LI,R13 SKIP SET EXIT B CINTIM CONVERT AND STASH SET8 DATA X'04000020' MBS 4 BYTES TO R8 * LOGICV LI,R5 8 SET BIT-IN-BYTE COUNTER LB,R9 0,R6 GET BYTE LOGICV1 CW,R9 BITPOS-32,R5 CHECK BIT BANZ YES 1 LI,R8 X'F0' 0 LOGICV2 BAL,R11 STASHIM STASH CHAR. BDR,R10 NXTBIT LOOP ON TOTAL BIT COUNT B SKIP EXIT YES LI,R8 X'F1' 1 B LOGICV2 NXTBIT BAL,R11 STASHBL SET INTERVENING BLANK BDR,R5 LOGICV1 LOOP ON BIT-IN-BYTE AI,R6 1 WORK NEXT BYTE B LOGICV * NAME AI,R4 -6 SET R4 -1 FOR STOP,0 FOR TRACE AI,R6 1 +1 FOR ORDINARY NAME LB,R5 0,R6 SLS,R10 8 AW,R5 R10 R5=NAME POINTER ,R4=FLAG FOR S OR T LI,R13 SKIP B CNAMEIM * * * ENDCONV-END OF DECODESTRING CONVERSION FOR OUTPUT-PHASE2 * ENDCONV LI,R12 ENDCONV1 END OF CODESTRING LW,R6 MODE CHECK MODE BGZ DUMPLINE NOT EDIT-MUST BE DISPLAY LW,R6 MERGECOL CHECK DISPLAY-APPEND-EDIT BNEZ DUMPLING DISPLAY OR EDIT-USE CR BAL,R11 PRMTIMAG APPEND-NO CR ENDCONV1 LW,R6 CURRCS SLS,R6 2 SET R6 FOR LEFT-RIGHT SCAN OF CS AI,R6 1 (PHASE 3) LI,R11 1 SET DIRECTION LEFT-RIGHT B STEP1 START PHASE 3 SCAN * * DECODEND-END OF PHASE 3 * DECODEND LB,R11 SAVENDS STB,R11 0,R6 RESTORE BYTE PAST END OF CS LW,R3 MODE CHECK MODE BGZ UNREF NOT EDIT-DEREF CS BLOCK LW,R3 ENDIMAGE FN EDIT AI,R3 1 GET CHAR COUNT B DECODRTN * * * DECODET-TABLE TO CONVERT CODESTRING TO CHARACTER IMAGE FOR OUTPUT * THIS TABLE IS USED IN THE FOLLOWING PHASES: * 1. RIGHT-LEFT SCAN TO FLIP KEY AND LENGTH BYTES TO * THE LEFT ON MULTTI-BYTE ITEMS. * * 2. LEFT-RIGHT SCAN TO GENERATE IMAGE OF INTERNAL * CHARACTERS-NOTE-THIS SCAN ALSO USES OUTRANS TABLE * TO SET MNEMONICS AS REQUIRED FOR TTY,PRINTER,ETC. * * 3. LEFT-RIGHT SCAN TO RESTORE CODESTRING TO EXECUTION * FORM. * * ENTRIES ABOVE BLANK (X'40') ARE SINGLE CHARACTER CODESTRING * ITEMS WHICH MAP TO SINGLE INTERNAL APL CHARACTERS * * ENTRIES BELOW BLANK INDICATE SPECIAL ACTION TO GET IMAGE * CHARACTERS-NUMERIC TRANSLATION,NAME LOOK UP,ETC. * CODESTRING BYTE IS KEY FOLLOWED BY INFORMATION BYTES * ACTION VECTOR: BYTES IN CODESTRING * 0 DUMMY-SKIP ITEM 1 * 1 ERROR 1 * 2 BOS-SKIP ITEM 1 * 3 SCALAR-TEXT 2 * 4 SCALAR-INTEGER-BYTE 2 * 5 STOPNAME -SYMTAB PTR 3 * 6 TRACENAME-SYMTAB PTR 3 * 7 NAME- SYMTAB PTR 3 * 8 SCALAR-INTEGER 5 * 9 SCALAR-REAL 9 * A VECTOR-BITS (L+7)/8+2 * B VECTOR-TEXT-SHORT L+2 * C COMMENT L+2 * D VECTOR-INTEGERS 4L+2 * E VECTOR-REALS 8L+2 * F LINE-SCAN ERROR L+2 * 10 VECTOR-TEXT-LONG L+3 (L=2 BYTES) * 11 END OF STATEMENT (TEMPORARY VALUE) * DECODET DATA X'F0F1F2F3' 0,1,2,3 DATA X'F4F5F6F7' 4,5,6,7 DATA X'F8F90408' 8,9,INTEGER-BYTE,INTEGER DATA X'09030A0D' REAL,CHAR,LOGICS,INTEGERS DATA X'0E0B100F' REALS,CHARS,MANY CHARS,LINESCAN ERR DATA X'0C050607' COMMENT,STOPNAME,TRACENAME,NAME DATA X'01B6B7B8' ERROR,QUAD0,QUAD1,QUAD2 DATA X'B9BABBBC' QUAD3-QUAD6 DATA X'BDBEBF53' QUAD7,QUAD8,QUAD9,QUAD DATA X'52025EB4' QQUAD,BOS,SEMI,LEFT BRACKET DATA X'B54D5DFC' RIGHT BRACKET,LPAREN,RPAREN,BRANCH DATA X'FD4B5A01' ASSIGNMENT,.,SMALL CIRCLE,ERROR DATA X'0101FE6F' ERROR,ERROR,DOMINO,QUESTION MARK DATA X'54636149' T-BAR,REDUCTION1,REDUCTION,IOTA DATA X'6C6B6858' RHO,COMMA,ROTATE1,ROTATE DATA X'B24E60FA' TRANSPOSE,+,-,MULTIPLY DATA X'FB5C5756' DIVIDE,*,LOG,CIRCLE DATA X'62444F41' MAX,MIN,ABS,BANG DATA X'01015146' ERROR,ERROR,I-BEAM,GRADE UP DATA X'735F0101' GRADE DOWN,NOT,ERROR,ERROR DATA X'FE6F5463' DOMINO,QUESTION MARK,T-BAR,REDUCT1 DATA X'61496C6B' REDUCTION,IOTA,RHO,COMMA DATA X'6858B24E' ROTATE1,ROTATE,TRANSPOSE,+ DATA X'60FAFB5C' -,MULTIPLY,DIVIDE,* DATA X'57566244' LOG,CIRCLE,MAX,MIN DATA X'4F414C74' ABS,BANG,LT,LE DATA X'6E767B7E' GT,GE,NE,= DATA X'70797778' AND,OR,NAND,NOR DATA X'01014255' ERROR,ERROR,DECODE,TEE DATA X'6A64B0B1' TAKE,DROP,EXPAND1,EXPAND DATA X'45010171' EPSILON,ERROR,ERROR,DIERESIS DATA X'726D437C' NEGSIGN,UNDERSCORE,%,ALPHA DATA X'667F754A' OMEGA,DEL,LOCK,CPL DATA X'67505B7A' CPR,CAP,CUP,: DATA X'01010011' ERROR,ERROR,DUMMY,END-OF-STMT * END