Programming Languages

Programming Languages: Geac ZOPL

This program is very verbose, because we used it in the training department. It is also not very elegant, since its author is not a very good programmer.

ZOPL  CPINPU     Rel.0 Rev. 000   Quick data entry to REGI file (uses LIOR)
*LIB,DLIB,LRLIOR,LRCTRL,LRTIME,LRERRP,/E
$PROG,0606
$DEBUG
*     Author: c.syed
*     Why:    rewrite data entry using LIOR routines
*
*  1 : A1+3    : 48   0  0    0 : COURSE   : ILL
*  2 : A1+6    : 96   3  0   48 : DATE     : 860520
*  3 : A1+18   :288   9  0  144 : STUDENT  :     
*  4 : A1+25   :400  27  0  432 : REGIS.BY :               
*  5 : A1+7    :112  52  0  832 : REG/DIV  : ISG    
*  6 : A1+19   :304  59  0  944 : JOBTITLE :                    
*  7 : A1+11   :176  78  0 1248 : TELEPHON :  
*  8 : A1+1    : 16  89  0 1424 : MANUAL   : N
*  9 : A1+1    : 16  90  0 1440 : CERTIF   : *
* 10 : A1+6    : 96  91  0 1456 : GRADE    : nil   
      DCL X["FFFF"X]
      DCL RET,OUTLEN,ANS
      DCL D:RECNUM
      DCL T:BATCH.NAME["TBEX88"2]
      DCL BFCB
      DCL CRS.NAME(3),CRS.DATE(6),STUD(18)
      DCL REGIS(25),DIV(7),JOB(19),PHON(11),MAN,CERT,GRADE(6)
      DCL TCB(2000)%% ye troll control block, standard size
      DCL BUF(80)
      DCL OUTBUF=BUF
      EXT L.OP,L.CL,L.NX,L.WR,L.DL
      EXT NORM,DIMM,BLINK
      EXT YESNO,RC
      KDCL JUNK[1]
$MAC write(?,?) = {L.WR(D:RECNUM,}?1,?2,{TCB)}%%this is an L.WR simplified
*                 %%just feed it field number and field name
$NOINIT%%  override normal 9000 data partition initializing
START
      CLEAR(EREG-$X,X,0); ZOPL.INITIALISE();%% clear data partition to zeros.
  RC(0,0); IOTY("-12"X,"\X",CHRLEN);
  BLINK();
  WHILE ANS_YESNO("Add students to registration file? \N(YE/NO)\O",%%
        STRLEN,"YENO"2) =0 DO
      L.OP("**REG3",TCB,RET);%%l.open returns 0 if good, <0 otherwise
*      L.OP("**REG5",TCB,RET);%%l.open returns 0 if good, <0 otherwise
      IF (RET # 0) DO;
          IOTY("12"X," Sorry CHARLIE, can't open this file",STRLEN)
          END;
      D:RECNUM_L.NX(TCB)%%  THIS GUY TAKES THE RECORD NUMBER!
      IOTY(2,"Next record is ",STRLEN)
      SNAT(3,D:RECNUM,2)
     WHILE RET < 3 DO;
      RET_IOTY(3,"COURSE NAME : ",STRLEN,CRS.NAME,3)
     END;
     WHILE RET < 6 DO;
      RET_IOTY(3,"COURSE DATE : YYMMDD\H\H\H\H\H\H\H",STRLEN,CRS.DATE,6)
     END;
 
     ++JUNK
*%%convention is to clear fields to "spaces" ("20"X) not "nulls" ("0"X) in LSD.
      RET_IOTY(3,"STUDENT : ",STRLEN,STUD,18); CLEAR(18-RET,^($STUD+RET),"20"X) 
      RET_IOTY(3,"MANAGER : ",STRLEN,REGIS,25); CLEAR(25-RET,^($REGIS+RET),"20"X)
      RET_IOTY(3,"DIVISION: ",STRLEN,DIV,7); CLEAR(7-RET,^($DIV+RET),"20"X) 
      RET_IOTY(3,"TITLE   : ",STRLEN,JOB,19); CLEAR(19-RET,^($JOB+RET),"20"X)
      RET_IOTY(3,"PHONE   : ",STRLEN,PHON,11); CLEAR(11-RET,^($PHON+RET),"20"X)
*%%$MAC pad(?)= {CLEAR(}?1{LEN-}?1,{^($}?1{+RET),"20"X};%%possible macro
WRIT
*     the "write" macro is a short form for the L.WR routine: i.e.
*      L.WR(D:RECNUM,field.number,buffer.name,TCB)
      write(1,CRS.NAME)%% 3-letter course code
      write(2,CRS.DATE)%%YYMMDD
      write(3,STUD)%% student name
      write(4,REGIS)%%manager's name
      write(5,DIV)%% max seven-letter site or division code 
      write(6,JOB) %%student's job title
      write(7,PHON)%% student's phone
 
*      L.WR(D:RECNUM,1,CRS.NAME,TCB);%%unstar these guys for an 8000
*      L.WR(D:RECNUM,2,CRS.DATE,TCB);%%they do the writing 
*      L.WR(D:RECNUM,3,STUD,TCB)
*      L.WR(D:RECNUM,4,REGIS,TCB)
*      L.WR(D:RECNUM,5,DIV,TCB)
*      L.WR(D:RECNUM,6,JOB,TCB)
*      L.WR(D:RECNUM,7,PHON,TCB)
*      L.WR(D:RECNUM,8,MAN,TCB)%% SELDOM USED ON INITIAL INPUT
*      L.WR(D:RECNUM,10,CERT,TCB)
*      L.WR(D:RECNUM,11,GRADE,TCB)
 
      L.CL(TCB);%% %%close ye troll control block!
    END;
FINISH
* BLINK(); IF D:RECNUM_MSNIT("delete a record? ",STRLEN) # 0 DO;
*            L.OP("**REG3",TCB,RET);%%l.open returns 0 if good, <0 otherwise
*             L.DL(D:RECNUM,TCB);
*             L.CL(TCB);
*          END;
          IF EXEC(200,T:BATCH.NAME,BFCB) <0 DO; 
              IOTY(2,"NO BATCH?",STRLEN); END;
          EXEC(4,1,BFCB,0)
*          EXEC(203,0,BFCB)
          EXEC(8,"UMENU "1)
   BLINK(); IOTY(2,"Unable to find menu. Sending you to KQ.\",STRLEN)
          EXEC(6)
              
$END  START

Explanation: This simple ZOPL 9000 program uses macros like "write" to do the work of commented-out LIOR routine code (like L.WR). Its function was to prompt for student information and to update a list of people taking training courses. The underscore is pronounced "gets" in Zopl - because on the old terminals like the "Informers", the equivalent character was a left-pointing-arrow, which makes perfect sense as an assignment operator. The commented out stuff in the header includes the "liberator card" field definitions, just for reference. (A liberator card was used to map field definitions into a large file's header. According to the GLIS Glossary (early 1980s), a liberated file is a file that has been liberated using the utility UMLIB. The liberated IO routines read and wrote to one).